PDA

Visualizza la versione completa : codice fiscale


BOYROMA1
17-05-2003, 16:43
qualcuno conosce il codice per calcolare inserendo in 3 text

nome

cognome

datadinascita


il codice fiscale??

amodio
17-05-2003, 17:01
Public Function CheckCodFiscale(aValue As String) As Boolean

aValue = UCase(aValue)

If Trim(aValue) = "" Then
CheckCodFiscale = True
Exit Function
End If
Dim I As Integer
Dim N As Integer
Dim TBC(36) As Integer
Dim nDispari As Integer
Dim nPari As Integer
TBC(0) = 0
TBC(1) = 1: TBC(2) = 0: TBC(3) = 5: TBC(4) = 7: TBC(5) = 9
TBC(6) = 13: TBC(7) = 15: TBC(8) = 17: TBC(9) = 19: TBC(10) = 21
TBC(11) = 2: TBC(12) = 4: TBC(13) = 18: TBC(14) = 20: TBC(15) = 11
TBC(16) = 3: TBC(17) = 6: TBC(18) = 8: TBC(19) = 12: TBC(20) = 14
TBC(21) = 16: TBC(22) = 10: TBC(23) = 22: TBC(24) = 25: TBC(25) = 24
TBC(26) = 23: TBC(27) = 1: TBC(28) = 0: TBC(29) = 5: TBC(30) = 7
TBC(31) = 9: TBC(32) = 13: TBC(33) = 15: TBC(34) = 17: TBC(35) = 19
TBC(36) = 21
' Controllo sulla lunghezza della stringa: deve essere di 16 caratteri
If Len(aValue) <> 16 Then
CheckCodFiscale = False
Exit Function
End If
' controllo sull'ultimo carattere
' ciclo dispari: primo char, terzo, ecc...
nDispari = 0
For I = 1 To 15 Step 2
N = Asc(Mid$(aValue, I, 1))
If N < 58 Then
N = N - 21
Else
N = N - 64
End If
If N < 0 Or N > 36 Then
CheckCodFiscale = False
End If
nDispari = nDispari + TBC(N)
Next I
' ciclo pari: secondo char, quarto, ecc...
nPari = 0
For I = 2 To 14 Step 2
N = Asc(Mid$(aValue, I, 1))
N = Asc(Mid$(aValue, I, 1))
If N < 58 Then
N = N - 48
Else
N = N - 65
End If
If N < 0 Or N > 36 Then
CheckCodFiscale = False
End If
nPari = nPari + N
Next I
I = (nPari + nDispari) Mod 26 + 65
N = Asc(Mid$(aValue, 16, 1))
If I = N Then
CheckCodFiscale = True
Else
CheckCodFiscale = False
End If
End Function

Loading