codice:
Option Explicit
Private m_Cognome As String
Private m_Nome As String
Private m_Sesso As String
Private m_DataNascita As String
Private m_Comune As String
Private m_Codice As String * 16
Private m_Valido As Boolean
Private m_Controllo As String * 1
Public Property Let Cognome(cString As String)
m_Cognome = cString
End Property
Public Property Let nome(cString As String)
m_Nome = cString
End Property
Public Property Let dataNascita(dString As Date)
m_DataNascita = dString
End Property
Public Property Let Sesso(cString As String)
m_Sesso = cString
End Property
Public Property Let Comune(cString As String)
m_Comune = cString
End Property
Public Property Let Codice(vNewValue As String)
m_Codice = vNewValue
End Property
Public Property Get Valido()
Dim X As String
X = digit(Left(m_Codice, 15))
Valido = IIf(X = Right(m_Codice, 1), True, False)
End Property
Public Property Get Codice() As String
Dim Consonanti As String
Dim Vocali As String
Dim i As Integer
Dim cTemp As String
Dim StrigaConfronto As String
'Calcolo della Parte 1: Cognome
Consonanti = ""
Vocali = ""
For i = 1 To Len(m_Cognome)
cTemp = Mid(m_Cognome, i, 1)
If InStr("AEIOU", cTemp) Then
If Len(Vocali) < 2 Then
Vocali = Vocali & cTemp
End If
Else
If Asc(cTemp) > 64 And Asc(cTemp) < 91 And Len(Consonanti) < 3 Then
Consonanti = Consonanti & cTemp
End If
End If
Next
StrigaConfronto = Mid(Consonanti & Vocali & "X", 1, 3)
If Len(StrigaConfronto) < 3 Then StrigaConfronto = StrigaConfronto & "X"
'Calcolo della Parte 2: Nome
Consonanti = ""
Vocali = ""
For i = 1 To Len(m_Nome)
cTemp = Mid(m_Nome, i, 1)
If InStr("AEIOU", cTemp) Then
If Len(Vocali) < 2 Then
Vocali = Vocali & cTemp
End If
Else
If Asc(cTemp) > 64 And Asc(cTemp) < 91 And Len(Consonanti) < 4 Then
Consonanti = Consonanti & cTemp
End If
End If
If Len(Consonanti) > 3 Then
Consonanti = Mid(Consonanti, 1, 1) & Mid(Consonanti, 3, 2)
i = Len(m_Nome)
End If
Next
If Len(Mid(Consonanti & Vocali & "X", 1, 3)) < 3 Then
StrigaConfronto = StrigaConfronto & Mid(Consonanti & Vocali & "X", 1, 3) & "X"
Else
StrigaConfronto = StrigaConfronto & Mid(Consonanti & Vocali & "X", 1, 3)
End If
'Anno di nascita
StrigaConfronto = StrigaConfronto & Mid(Year(m_DataNascita), 3, 2)
'Mese di nascita
StrigaConfronto = StrigaConfronto & Mid("ABCDEHLMPRST", Month(m_DataNascita), 1)
'Giorno di nascita
StrigaConfronto = StrigaConfronto & IIf(m_Sesso = "M", Mid(Format(100 + Day(m_DataNascita)), 2, 2), Mid(Format(140 + Day(m_DataNascita)), 2, 2))
'Codice Comune di nascita
StrigaConfronto = StrigaConfronto & m_Comune
'Numero di controllo
If Len(StrigaConfronto) = 15 Then
StrigaConfronto = StrigaConfronto & digit(StrigaConfronto)
Codice = StrigaConfronto
Else
MsgBox "I dati immessi non sono validi", vbCritical, "Errore di input"
End If
End Property
Private Function digit(xCodice)
On Error GoTo Err
Dim sc As String
Dim cPari As String
Dim cDispari As String
Dim numCTRL As Integer
Dim i As Integer
Dim temp As Integer
'
sc = "01,00,05,07,09,13,15,17,19,21,02,04,18,20,11,03,06,08,12,14,16,10,22,25,24,23"
numCTRL = 0
For i = 2 To 14 Step 2
cPari = Mid(xCodice, i, 1)
If cPari >= "A" Then
temp = Asc(cPari) - Asc("A")
Else
temp = Asc(cPari) - Asc("0")
End If
numCTRL = numCTRL + temp
Next i
For i = 1 To 15 Step 2
cDispari = Mid(xCodice, i, 1)
If cDispari >= "A" Then
temp = Val(Mid(sc, (Asc(cDispari) - Asc("A")) * 3 + 1, 2))
Else
temp = Val(Mid(sc, (Asc(cDispari) - Asc("0")) * 3 + 1, 2))
End If
numCTRL = numCTRL + temp
Next i
numCTRL = (numCTRL Mod 26) + 65
digit = Chr(numCTRL)
Exit Function
Err:
MsgBox "Si è verificato un errore durante la creazione del codice fiscale.", vbCritical, "Attenzione!"
End Function