Public Function CheckCodFiscale(CFis As String) As Boolean
    'Autore: Federico Luciani
    'Accetta: CFis = Codice fiscale da verificare
    'Restituisce: true se il Codice fiscale è corretto
    If Len(CFis) <> 16 Then
       CheckCodFiscale = False
       Exit Function
    End If
    Dim i As Integer, p As Integer, d As Integer
    Dim SumDisp As Integer, SumPari As Integer
    Dim SumTot As Integer, Check As String
    Dim Resto(1 To 26) As String
    Resto(1) = "A"
    Resto(2) = "B"
    Resto(3) = "C"
    Resto(4) = "D"
    Resto(5) = "E"
    Resto(6) = "F"
    Resto(7) = "G"
    Resto(8) = "H"
    Resto(9) = "I"
    Resto(10) = "J"
    Resto(11) = "K"
    Resto(12) = "L"
    Resto(13) = "M"
    Resto(14) = "N"
    Resto(15) = "O"
    Resto(16) = "P"
    Resto(17) = "Q"
    Resto(18) = "R"
    Resto(19) = "S"
    Resto(20) = "T"
    Resto(21) = "U"
    Resto(22) = "V"
    Resto(23) = "W"
    Resto(24) = "X"
    Resto(25) = "Y"
    Resto(26) = "Z"
    For i = 2 To 14 Step 2
        Select Case Mid$(CFis, i, 1)
            Case "0": p = 0
            Case "1": p = 1
            Case "2": p = 2
            Case "3": p = 3
            Case "4": p = 4
            Case "5": p = 5
            Case "6": p = 6
            Case "7": p = 7
            Case "8": p = 8
            Case "9": p = 9
            Case "A": p = 0
            Case "B": p = 1
            Case "C": p = 2
            Case "D": p = 3
            Case "E": p = 4
            Case "F": p = 5
            Case "G": p = 6
            Case "H": p = 7
            Case "I": p = 8
            Case "J": p = 9
            Case "K": p = 10
            Case "L": p = 11
            Case "M": p = 12
            Case "N": p = 13
            Case "O": p = 14
            Case "P": p = 15
            Case "Q": p = 16
            Case "R": p = 17
            Case "S": p = 18
            Case "T": p = 19
            Case "U": p = 20
            Case "V": p = 21
            Case "W": p = 22
            Case "X": p = 23
            Case "Y": p = 24
            Case "Z": p = 25
        End Select
        SumPari = SumPari + p
    Next i
    For i = 1 To 15 Step 2
        Select Case Mid$(CFis, i, 1)
            Case "0": d = 1
            Case "1": d = 0
            Case "2": d = 5
            Case "3": d = 7
            Case "4": d = 9
            Case "5": d = 13
            Case "6": d = 15
            Case "7": d = 17
            Case "8": d = 19
            Case "9": d = 21
            Case "A": d = 1
            Case "B": d = 0
            Case "C": d = 5
            Case "D": d = 7
            Case "E": d = 9
            Case "F": d = 13
            Case "G": d = 15
            Case "H": d = 17
            Case "I": d = 19
            Case "J": d = 21
            Case "K": d = 2
            Case "L": d = 4
            Case "M": d = 18
            Case "N": d = 20
            Case "O": d = 11
            Case "P": d = 3
            Case "Q": d = 6
            Case "R": d = 8
            Case "S": d = 12
            Case "T": d = 14
            Case "U": d = 16
            Case "V": d = 10
            Case "W": d = 22
            Case "X": d = 25
            Case "Y": d = 24
            Case "Z": d = 23
        End Select
        SumDisp = SumDisp + d
    Next i
    SumTot = SumPari + SumDisp
    Check = Resto((SumTot Mod 26) + 1)
    If Check = UCase$(Right(CFis, 1)) Then
       CheckCodFiscale = True
    Else
       CheckCodFiscale = False
    End If
End Function