Il codice fiscale (metodo di calcolo)

'Dove cf è una stringa contenente i primi 15 caratteri del codice fiscale da controllare 
'(non gestisce i casi di Omocodia)
Function CalcolaCIN (cf As String) As String
    
    Dim cin As Integer, i As Integer, alterna As Integer, car As Integer
    Dim num  As String * 1
    Const CARATTERIDISPARI = 1
    Const NUMLETT = "111111001001000"	‘ 1 = lettera, 0 = Numero
    Const TD = "0100050709131517192102041820110306081214161022252423"
    alterna = 1

    For i = 1 To 15
        car = Asc(Mid$(cf, i, 1))
        If car > 47 And car < 58 Then			'cifre da 0 a 9
            car = car - 48
            num = "0"
        ElseIf car > 64 And car < 91 Then		'lettere
            car = car - 65
            num = "1"
        Else
            num = "3"
        End If
	
        'se c'é una discordanza sulla posizione lettera/numero
        If num <> Mid$(NUMLETT, i, 1) Then
            'memorizza la posizione dell'errore ed esci, ritorna una stringa > 1 carattere
            CalcolaCIN = Str(i) + "Errore"
            Exit Function
        End If

        If alterna = CARATTERIDISPARI Then
            cin = cin + Val(Mid$(TD, car * 2 + 1, 2))	‘Legge un numero nella stringa TD
            alterna = 0
        Else
            cin = cin + car
            alterna = 1
        End If
    Next i

    cin = (cin - Int(cin / 26) * 26) + 65
    'Ritorna una stringa di un carattere contenente il CIN
    CalcolaCIN = Chr$(cin)
        
End Function

tmp = codice fiscale completo

    If CalcolaCIN(Left$(tmp, 15)) <> Right$(tmp, 1) Then
        MsgBox ("Errore nel Codice Fiscale")
    Else
        MsgBox ("Codice Fiscale esatto")
    End If 

' strdata formato =  GGMMAA oppure GGMMAAAA
'passare strdata nel formato ggmmaa o ggmmaaaa
'sesso se = 0 é maschile, se = 1 é femminile
Function DecodificaData (strdata As String, sesso As Integer) As String
Dim i As Integer
    Dim mesi, risultato As String
        
    'MESI CODIFICATI
    Const mesi = "ABCDEHLMPRST"

    risultato = Right$ (strdata, 2)							‘Legge anno
    risultato = risultato + Mid$ (mesi, Val(Mid$(strdata, 3, 2)), 1)			‘codifica mese in lettera
    risultato = risultato + Right$ ("0" + Trim(Str(Val(Left$(strdata, 2)) + 40 * sesso)), 2)	‘legge giorno + sesso * 40

    DecodificaData = risultato							‘data nel formato AAMGG
End Function

'stringa  =  stringa da cui eliminare i simboli
Function EliminaSimboli (stringa As String) As String
    Dim i As Integer, risultato As String, car As String * 1
    
    stringa = UCase$(stringa)
    For i = 1 To Len(stringa)
        car = Mid$(stringa, i, 1)
        If car >= "0" And car <= "Z" Then			'considera solo (?) i numeri e le lettere maiuscole
            risultato = risultato + car
        End If
    Next i
    EliminaSimboli = risultato
End Function

'stringa  =  nome o cognome passati alternativamente
'nc = 1     codifica nome, nc = 0     codifica cognome
Function CodificaCognomeNome (stringa As String, nc As Integer) As String
    Dim i As Integer, vocali As String
    Dim conson As String, car As String * 1
    
    stringa = EliminaSimboli (stringa)
    For i = 1 To Len(stringa)
        car = Mid$(stringa, i, 1)
        If InStr("AEIOU", car) <> 0 Then				'separa le consonanti dalle vocali
            vocali = vocali + car
        Else
            conson = conson + car
        End If
    Next i
    CodificaCognomeNome = Left$(conson + vocali + "X", 3)
    If nc = 1 And Len(conson) > 3 Then				'nome
        CodificaCognomeNome = Left$(conson, 1) + Mid$(conson + vocali, 3, 2) + vocali + "X"
    End If
End Function