[VBA] Codice Fiscale

' https://pastebin.com/u/nellorizzo
Function GestisciCognome(cognome As String)
    ' prendo il cognome
    Dim c As String
    c = UCase(cognome)
    ' di esso prendo le consonanti
    Dim risultato As String
    risultato = PrendiConsonanti(c)
    ' se sono meno di 3 aggiungo le vocali
    If Len(risultato) < 3 Then risultato = risultato & PrendiVocali(c)
    ' se ancora sono meno di 3 aggiungo una X
    If Len(risultato) < 3 Then risultato = risultato & "XXX"
    ' restituisco il risultato
    GestisciCognome = Left(risultato, 3)
End Function

Function PrendiConsonanti(testo As String)
    ' preparo una variabile che possa contenere
    ' il risultato!
    Dim risultato As String
    Dim indice As Integer ' variabile contatore
    ' scandisco gli elementi nel testo!
    For indice = 1 To Len(testo)
        ' prendo l'i-esimo carattere
        Dim car As String
        car = Mid(testo, indice, 1)
        ' controllo che sia un carattere alfabetico
        If car >= "A" And car <= "Z" Then
            ' siamo sicuri che sia un carattere alfabetico
            ' devo controllare che sia una consonante
            If InStr("AEIUO", car) = 0 Then
                ' controllo che NON sia vocale!
                ' in questo caso lo aggiungo al risultato
                risultato = risultato & car
            End If
        End If
    Next
    PrendiConsonanti = risultato
End Function
Function PrendiVocali(testo As String)
    ' preparo una variabile che possa contenere
    ' il risultato!
    Dim risultato As String
    Dim indice As Integer ' variabile contatore
    ' scandisco gli elementi nel testo!
    For indice = 1 To Len(testo)
        ' prendo l'i-esimo carattere
        Dim car As String
        car = Mid(testo, indice, 1)
        ' controllo che sia un carattere alfabetico
        If car >= "A" And car <= "Z" Then
            ' siamo sicuri che sia un carattere alfabetico
            ' devo controllare che sia una consonante
            If InStr("AEIUO", car) > 0 Then
                ' controllo che NON sia vocale!
                ' in questo caso lo aggiungo al risultato
                risultato = risultato & car
            End If
        End If
    Next
    PrendiVocali = risultato
End Function

Function GestisciNome(nome As String)
    ' funziona come per il cognome
    Dim n As String
    n = UCase(nome)
    Dim risultato As String
    risultato = PrendiConsonanti(n)
    If Len(risultato) > 3 Then ' tranne se ci sono più di 3 consonanti
        ' prendo la 1, 3, 4
        risultato = Left(risultato, 1) & Mid(risultato, 3, 2)
    ElseIf Len(risultato) < 3 Then
        risultato = risultato & PrendiVocali(n)
    End If
    If Len(risultato) < 3 Then risultato = risultato & "XXX"
    GestisciNome = Left(risultato, 3)
End Function
Function GestisciData(datanascita As Date, sesso As String)
    Dim giorno As Integer
    Dim mese As String
    Dim anno As String

    anno = Right(Year(datanascita), 2)
    mese = Mid("ABCDEHLMPRST", Month(datanascita), 1)
    giorno = Day(datanascita)
    If sesso = "F" Or sesso = "f" Then
        giorno = giorno + 40
    End If

    GestisciData = anno & mese & Right("0" & giorno, 2)
End Function

Function CalcolaCodiceControllo(testo As String)
    If Len(testo) = 15 Then
        ' calcolo il codice di controllo SOLO
        ' se ho a disposizione tutti 1 15 i caratteri
        Dim somma As Integer
        Dim spiazzamento As Integer
        ' dobbiamo scorrere i 15 caratteri
        For indice = 1 To 15
            ' prendo l'iesimo carattere
            Dim car As String
            car = Mid(testo, indice, 1)
            ' controllo se il carattere è una cifra o una lettera
            If car >= "A" And car <= "Z" Then
                ' è una lettera
                spiazzamento = Asc(car) - Asc("A")
            Else
                ' è una cifra
                spiazzamento = Asc(car) - Asc("0")
            End If
            ' se sono in posizione pari
            If indice Mod 2 = 0 Then
            ' faccio qualcosa
                somma = somma + spiazzamento
            Else
            ' altrimenti
                ' ne faccio un'altra...
            End If
        Next
        CalcolaCodiceControllo = Chr(Asc("A") + somma Mod 26)
    Else
        ' se non ho a disposizione 15 caratteri
        ' restituisco una X (valore fittizio)
        CalcolaCodiceControllo = "X"
    End If
End Function