Function codicefiscale(ByVal nome As String, ByVal cognome As String, ByVal data As String, ByVal sesso As String, ByVal comune As String) As String
Dim inome, icognome, icomune, controllo, temp As String
Dim letteracod As String
'prendi le iniziali del nome
Dim ccc As Long = 1
For i = 1 To Len(nome)
temp = LCase(Mid(nome, i, 1))
Select Case temp
Case "b"
inome += temp
Case "c"
inome += temp
Case "d"
inome += temp
Case "f"
inome += temp
Case "g"
inome += temp
Case "h"
inome += temp
Case "j"
inome += temp
Case "k"
inome += temp
Case "l"
inome += temp
Case "m"
inome += temp
Case "n"
inome += temp
Case "p"
inome += temp
Case "q"
inome += temp
Case "r"
inome += temp
Case "s"
inome += temp
Case "t"
inome += temp
Case "v"
inome += temp
Case "w"
inome += temp
Case "x"
inome += temp
Case "y"
inome += temp
Case "z"
inome += temp
End Select
Next
If Len(inome) >= 4 Then
temp = LCase(inome)
inome = Mid(temp, 1, 1) & Mid(temp, 3, 1) & Mid(temp, 4, 1)
End If
'controlla la lunghezza delle iniziali
If Len(inome) > 3 Then
inome = Mid(inome, 1, 3)
ElseIf Len(inome) < 3 Then
For i = 1 To Len(nome)
letteracod = Mid(nome, i, 1)
Select Case letteracod
Case "a"
inome += "a"
Case "e"
inome += "e"
Case "i"
inome += "i"
Case "o"
inome += "o"
Case "u"
inome += "u"
End Select
Next
If Len(inome) > 3 Then
inome = Mid(inome, 1, 3)
ElseIf Len(inome) < 3 Then
For i = Len(inome) To 3
inome += "x"
Next
End If
End If
'prendi lettere del cognome
For i = 1 To Len(cognome)
temp = LCase(Mid(cognome, i, 1))
Select Case temp
Case "b"
icognome += temp
Case "c"
icognome += temp
Case "d"
icognome += temp
Case "f"
icognome += temp
Case "g"
icognome += temp
Case "h"
icognome += temp
Case "j"
icognome += temp
Case "k"
icognome += temp
Case "l"
icognome += temp
Case "m"
icognome += temp
Case "n"
icognome += temp
Case "p"
icognome += temp
Case "q"
icognome += temp
Case "r"
icognome += temp
Case "s"
icognome += temp
Case "t"
icognome += temp
Case "v"
icognome += temp
Case "w"
icognome += temp
Case "x"
icognome += temp
Case "y"
icognome += temp
Case ("z")
icognome += temp
End Select
Next
'controlla la lunghezza delle iniziali
If Len(icognome) > 3 Then
icognome = Mid(icognome, 1, 3)
ElseIf Len(icognome) < 3 Then
'minore di tre cifre prendi anche le vocali
For i = 1 To Len(cognome)
letteracod = Mid(cognome, i, 1)
Select Case letteracod
Case "a"
icognome += "a"
Case "e"
icognome += "e"
Case "i"
icognome += "i"
Case "o"
icognome += "o"
Case "u"
icognome += "u"
End Select
Next
If Len(icognome) > 3 Then
icognome = Mid(icognome, 1, 3)
ElseIf Len(icognome) < 3 Then
For i = Len(icognome) To 3
icognome += "x"
Next
End If
End If
'calola le cifre della data
Dim idata, gg, mm, aa As String
temp = data
Dim tempn As Short
tempn = InStr(temp, "/")
gg = Mid(data, 1, tempn - 1)
temp = Mid(data, 4)
tempn = InStr(temp, "/")
mm = Mid(temp, 1, tempn - 1)
temp = Mid(temp, 4)
aa = Mid(temp, 3)
idata = aa
Select Case mm
Case "01"
idata += "a"
Case "02"
idata += "b"
Case "03"
idata += "c"
Case "04"
idata += "d"
Case "05"
idata += "e"
Case "06"
idata += "h"
Case "07"
idata += "l"
Case "08"
idata += "m"
Case "09"
idata += "p"
Case "10"
idata += "r"
Case "11"
idata += "s"
Case "12"
idata += "t"
End Select
If sesso = "Maschio" Then
idata += gg
ElseIf sesso = "Femmina" Then
idata += gg + 40
End If
'codice parziale per calcolare ultima cifra
Dim parz As String
parz = LCase(icognome & inome & idata & comune)
'trova il carattere di verificca
Dim d, p As String
Dim vdis, vpar As Long
For i = 1 To 15 Step 2
d = Mid(parz, i, 1)
Select Case d
Case "0"
vdis += 1
Case "1"
vdis += 0
Case "2"
vdis += 5
Case "3"
vdis += 7
Case "4"
vdis += 9
Case "5"
vdis += 13
Case "6"
vdis += 15
Case "7"
vdis += 17
Case "8"
vdis += 19
Case "9"
vdis += 21
Case "a"
vdis += 1
Case "b"
vdis += 0
Case "c"
vdis += 5
Case "d"
vdis += 7
Case "e"
vdis += 9
Case "f"
vdis += 13
Case "g"
vdis += 15
Case "h"
vdis += 17
Case "i"
vdis += 19
Case "j"
vdis += 21
Case "k"
vdis += 2
Case "l"
vdis += 4
Case "m"
vdis += 18
Case "n"
vdis += 20
Case "o"
vdis += 11
Case "p"
vdis += 3
Case "q"
vdis += 6
Case "r"
vdis += 8
Case "s"
vdis += 12
Case "t"
vdis += 14
Case "u"
vdis += 16
Case "v"
vdis += 10
Case "w"
vdis += 22
Case "x"
vdis += 25
Case "y"
vdis += 24
Case "z"
vdis += 23
End Select
Next
For i = 2 To 14 Step 2
p = Mid(parz, i, 1)
Select Case p
Case "0"
vpar += 0
Case "1"
vpar += 1
Case "2"
vpar += 2
Case "3"
vpar += 3
Case "4"
vpar += 4
Case "5"
vpar += 5
Case "6"
vpar += 6
Case "7"
vpar += 7
Case "8"
vpar += 8
Case "9"
vpar += 9
Case "a"
vpar += 0
Case "b"
vpar += 1
Case "c"
vpar += 2
Case "d"
vpar += 3
Case "e"
vpar += 4
Case "f"
vpar += 5
Case "g"
vpar += 6
Case "h"
vpar += 7
Case "i"
vpar += 8
Case "j"
vpar += 9
Case "k"
vpar += 10
Case "l"
vpar += 11
Case "m"
vpar += 12
Case "n"
vpar += 13
Case "o"
vpar += 14
Case "p"
vpar += 15
Case "q"
vpar += 16
Case "r"
vpar += 17
Case "s"
vpar += 18
Case "t"
vpar += 19
Case "u"
vpar += 20
Case "v"
vpar += 21
Case "w"
vpar += 22
Case "x"
vpar += 23
Case "y"
vpar += 24
Case "z"
vpar += 25
End Select
Next
Dim vdisparsomma As Long
'somma dei valori ottenuti dal dispari e dal pari
vdisparsomma = vdis + vpar
'---------------------
' vdisparsomma = 148
'---------------------
'diviso 26, troviamo il resto
Dim restov As Decimal
restov = vdisparsomma Mod 26
Select Case restov
Case 0
controllo = "a"
Case 1
controllo = "b"
Case 2
controllo = "c"
Case 3
controllo = "d"
Case 4
controllo = "e"
Case 5
controllo = "f"
Case 6
controllo = "g"
Case 7
controllo = "h"
Case 8
controllo = "i"
Case 9
controllo = "j"
Case 10
controllo = "k"
Case 11
controllo = "l"
Case 12
controllo = "m"
Case 13
controllo = "n"
Case 14
controllo = "o"
Case 15
controllo = "p"
Case 16
controllo = "q"
Case 17
controllo = "r"
Case 18
controllo = "s"
Case 19
controllo = "t"
Case 20
controllo = "u"
Case 21
controllo = "v"
Case 22
controllo = "w"
Case 23
controllo = "x"
Case 24
controllo = "y"
Case 25
controllo = "z"
End Select
'fai il codice fiscale
codicefiscale = UCase(parz & controllo)
End Function
'fine
'il calcolo del codice fiscale funziona correttamente

la funziona fa parte di un programma che sto terminando per la gestione della vendita di olive da mensa...
Essa serve per calcolare il codice fiscale di qualsiasi persone conoscendo il nome,cognome,data di nascita, luogo di nascita e sesso...