Codice Fiscale

Ciao peppe,

ti giro una funzione per il calcolo del CF che ho reperito tempo fa (non so se nel forum stesso o in rete) che mi sembra funzionare egregiamente, poi dai anche una guardata al seguente link:

http://www.pug.univ.trieste.it/docenti/economia/merson/merson.htm



Codice
------------------------

Public Function CODFISC(Cogn, Nome, Data, SS, CodCom)
Dim cognome As String
Dim cons As String * 21
Dim Pari1 As String * 26
Dim Pari11 As String * 10
Dim dispari As String * 52
Dim cfp As String
Dim riempie As String * 3
Dim s As Integer
Dim p As Integer
fi1 = Cogn
fi2 = Nome
fi3 = Data
fi4 = SS
fi5 = CodCom
cons = "BCDFGHLMNPQRSTVWKXYJZ"
Voca = "AEIOU"
Mese = "ABCDEHLMPRST"
Pari1 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Pari11 = "0123456789"
dispari = "0100050709131517192102041820110306081214161022252423"
riempie = "XXX"
fi1 = UCase(Trim(fi1))
fi2 = UCase(Trim(fi2))
fi4 = UCase(Trim(fi4))
lu1 = fi1
nu1 = Len(lu1)
lu2 = fi2
nu2 = Len(lu2)
cognome = " "
For i = 1 To nu1 Step 1
co = Mid(lu1, i, 1)
For N = 1 To Len(cons)
If co = Mid(cons, N, 1) Then
cognome = cognome + co
End If
Next N
Next i
hu11 = Trim(cognome)
nu11 = Len(hu11)
cognome = " "
If nu11 < 3 Then
For i = 1 To nu1 Step 1
co = Mid(lu1, i, 1)
For N = 1 To Len(Voca)
If co = Mid(Voca, N, 1) Then
cognome = cognome + co
End If
Next N
Next i
End If
cognome = Trim(cognome)
lu1 = hu11 + cognome
lu1 = Left(lu1, 3)
lu1 = Trim(lu1)
nu11 = Len(lu1)
If nu11 < 3 Then
lu1 = lu1 + Mid(riempie, 1, (3 - nu11))
End If
Nome = " "
cont = 0
For i = 1 To nu2 Step 1
co = Mid(lu2, i, 1)
For N = 1 To Len(cons)
If co = Mid(cons, N, 1) Then
cont = cont + 1
End If
Next N
Next i
coris = " "
If cont > 3 Then
Nome = " "
cont = 0
For i = 1 To nu2 Step 1
co = Mid(lu2, i, 1)
For N = 1 To Len(cons)
If co = Mid(cons, N, 1) Then
cont = cont + 1
If cont = 2 Then
coris = co
Else
Nome = Trim(Nome + co)
End If
End If
Next N
Next i
Else
Nome = " "
cont = 0
For i = 1 To nu2 Step 1
co = Mid(lu2, i, 1)
For N = 1 To Len(cons)
If co = Mid(cons, N, 1) Then
Nome = Trim(Nome + co)
End If
Next N
Next i
End If
hu11 = Trim(hu11)
hu11 = Mid(Nome, 1, 3)
nu11 = Len(hu11)
If nu11 < 3 Then
If coris = "" Then
hu11 = hu11 + Trim(coris)
End If
End If
nu11 = Len(Trim(hu11))
If nu11 < 3 Then
Nome = " "
For i = 1 To nu2 Step 1
co = Mid(lu2, i, 1)
For N = 1 To Len(cons)
If co = Mid(Voca, N, 1) Then
Nome = Trim(Nome + co)
End If
Next N
Next i
End If
lu2 = Trim(Mid(hu11 + Nome, 1, 3))
If Len(lu2) < 3 Then
lu2 = lu2 + Mid(riempie, 1, (3 - Len(lu2)))
End If
giorno = Left(fi3, 2)
SS = Mid(fi3, 4, 2)
gi = LTrim(giorno)
If fi4 = "F" Then
g = Val(fi3) + 40
gi = LTrim(Str(g))
End If
anno = Right(fi3, 2)
Ms = Mid(Mese, SS, 1)
CF = lu1 + lu2 + anno + Mid(Mese, SS, 1) + gi + fi5
a = 0
For i = 2 To 14 Step 2
cfp = Mid(CF, i, 1)
If InStr(Pari1, cfp) > 0 Then
a = a + InStr(Pari1, cfp) - 1
Else
a = a + InStr(Pari11, cfp) - 1
End If
Next
b = 0
ric = 0
For i = 1 To 15 Step 2
cfp = Mid(CF, i, 1)
If InStr(Pari1, cfp) > 0 Then
ric = InStr(Pari1, cfp) * 2 - 1
b = b + Val(Mid(dispari, ric, 2))
Else
ric = InStr(Pari11, cfp) * 2 - 1
b = b + Val(Mid(dispari, ric, 2))
End If
Next
c = a + b
d = Int(c / 26)
e = c - d * 26
finale = Mid(Pari1, e + 1, 1)
CF = CF + finale
CODFISC = CF
End Function

-------------------------------
Ciao

mario