A volte capita di dover controllare un codice fiscale se esista o meno. Vi rimettiamo questa comoda funzione, che resituisce zero se il codice fiscale passato è valido.
Public Function CheckCodiceFiscale(ByVal sz_Codice As String) As Integer
'======================================
'Controllo il codice fiscale
'======================================
Const ALF1 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Const CIF1 = "0123456789"
Const ALF2 = "BAKPLCQDREVOSFTGUHMINJWZYX"
Const CIF2 = "10 2 3 4 5 6 7 8 9 "
Dim c_Char As String * 1
Dim c_Code As String * 1
Dim n_Count As Integer
Dim lcv As Integer
'----- Start
sz_Codice = Left(UCase(sz_Codice) + space(16), 16)
For lcv = 2 To 14 Step 2
c_Char = Mid$(sz_Codice, lcv, 1)
Select Case c_Char
Case "0" To "9"
n_Count = n_Count + InStr(CIF1, c_Char)
Case "A" To "Z"
n_Count = n_Count + InStr(ALF1, c_Char)
End Select
Next lcv
For lcv = 1 To 15 Step 2
c_Char = Mid$(sz_Codice, lcv, 1)
Select Case c_Char
Case "0" To "9"
n_Count = n_Count + InStr(CIF2, c_Char)
Case "A" To "Z"
n_Count = n_Count + InStr(ALF2$, c_Char)
End Select
Next lcv
n_Count = 1 + ((n_Count - 15) Mod 26) + 64
c_Code = Chr$(n_Count)
c_Char = Mid$(sz_Codice, 16, 1)
If c_Code = c_Char Then
CheckCodiceFiscale = 0
Else
CheckCodiceFiscale = n_Count
End If
End Function
Funziona anche per CF con omocodia????
RispondiElimina