Newsgroup: it.comp.appl.access
Titolo: Codice fiscale

Grazie anticipate a chiunque possa aiutarmi.
Sul sito comune trovi quello che cerchi.
Alfio

 wrote in message
Gr8x4.5275$i%1.5...@news.infostrada.it...


 controllo della sua esattezza!
Scusa, ma non e' molto diverso generare e controllare, ma se non vuoi
mettere mano al VBA mi sa che non c'e' molto da fare.
Sib
--
------------------------------------------------------
il sito comune di it.comp.database.access:
http://members.xoom.it/it_db_access
------------------------------------------------------
4000 anni fa', il saggio egizio Ptahhotep scrisse:
"... perche' non esistono saggi per nascita."
------------------------------------------------------
Saturiamo ECHELON:
bomba saddam attentato medio oriente

 mettere mano al VBA mi sa che non c'e' molto da fare.
MOOOOOLTO diverso!!
Il controllo è solo la verifica di un checksum
La generazione segue molte altre regole.
Il avevo fatto un programmino in Clipper/Fivewin che generava il cod.
fiscale. Appena ho tempo lo trasformo in Access. Se qualcuno vuole provarci
prima, me lo faccia sapere. Oltre al programma sorgente serve ovviamente la
tabella dei Comuni e Stati esteri con il codice Belfiore che posso allegare.
harry...@tin.it

 Grazie anticipate a chiunque possa aiutarmi.
Creati una form, inserisci questi controlli:
txtcognome
txtnome
cbosesso (casella combinata con Elenco valori M;F)
CasComb (casella combinata legata alla tabella comuni per la scelta dello
stesso)
txtDataNascita
TxtCodFis (è il controllo che accogliera il codice fiscale creato).
Beccate stò codice schiaffalo dentro un pursante e buon lavoro!!
    Dim Temp        As String
    Dim Vocali      As String
    Dim Consonanti  As String
    Dim I           As Integer
    Dim AppoNum     As Long
    Dim TempNum     As Long
    Dim TxtCodFis   As String
    Dim Cognome$, Nome$, Sesso$, Provincia$
    Dim DataNascita As Date
'Verifica i dati nei controlli della form
If IsNull(txtcognome) Then
    MsgBox ("Inserire il Cognome!")
    Exit Sub
End If
If IsNull(txtnome) Then
    MsgBox ("Inserire il Nome!")
    Exit Sub
End If
If IsNull(cboSesso) Then
    MsgBox ("Inserire il Sesso!")
    Exit Sub
End If
If IsNull(CasComb) Then  'Casella combinata legata alla tabella Comuni che
contiene Codice, Provincia e Descrizione del comune stesso
    MsgBox ("Inserire il Comune!")
    Exit Sub
End If
    If IsDate(txtDataNascita) = False Then
        MsgBox "La data di Nascita non e' valida."
    Else
    TxtCodFis = ""
    Cognome$ = txtcognome
    Nome$ = txtnome
    Sesso$ = cboSesso
    DataNascita = txtDataNascita
    Provincia$ = Trim(CasComb)
    '
    ' RICAVO IL COGNOME (123)
    '
    Cognome$ = StrConv(Cognome$, vbUpperCase)
    Vocali = ""
    Consonanti = ""
    For I = 1 To Len(Cognome$)
        If InStr("AEIOU", Mid(Cognome$, I, 1)) Then
            Vocali = Vocali + Mid(Cognome$, I, 1)
        ElseIf InStr("BCDFGHJKLMNPQRSTVWXYZ", Mid(Cognome$, I, 1)) Then
            Consonanti = Consonanti + Mid(Cognome$, I, 1)
        Else
            ' E' uno spazio, un apostrofo o altro che non va considerato
        End If
       If Len(Consonanti) = 3 Then Exit For
    Next
    If Len(Consonanti) < 3 Then Consonanti = Consonanti + Left(Vocali, 3 -
Len(Consonanti))
    If Len(Consonanti) < 3 Then Consonanti = Consonanti + String(3 -
Len(Consonanti), "X")
    TxtCodFis = Consonanti
    '
    ' RICAVO IL NOME (456)
    '
    Nome$ = StrConv(Nome$, vbUpperCase)
    Vocali = ""
    Consonanti = ""
    For I = 1 To Len(Nome$)
        If InStr("AEIOU", Mid(Nome$, I, 1)) Then
            Vocali = Vocali + Mid(Nome$, I, 1)
        ElseIf InStr("BCDFGHJKLMNPQRSTVWXYZ", Mid(Nome$, I, 1)) Then
            Consonanti = Consonanti + Mid(Nome$, I, 1)
        Else
            ' E' uno spazio, un apostrofo o altro che non va considerato
        End If
    Next I
    If Len(Consonanti) >= 4 Then
        ' isolo la prima, terza e quarta consonante
        Consonanti = Left$(Consonanti, 1) & Mid$(Consonanti, 3, 2)
    ElseIf Len(Consonanti) = 3 Then
        ' Va bene cosi'
    Else
        ' Aggiungo le vocali
        Consonanti = Left$(Consonanti & Vocali, 3)
        ' se non basta, aggiungo le X
        If Len(Consonanti) < 3 Then Consonanti = Left$(Consonanti & "XXX",
3)
    End If
    TxtCodFis = TxtCodFis & Consonanti
    '
    'Anno di nascita (78)
    '
    TxtCodFis = TxtCodFis + Right(Format$(Year(DataNascita), "0000"), 2)
    '
    'Mese di nascita(9)
    '
    TxtCodFis = TxtCodFis & Mid$("ABCDEHLMPRST", Month(DataNascita), 1)
    '
    'Giorno di nascita(0A)
    '
    If UCase(Sesso$) = "F" Then
        TxtCodFis = TxtCodFis & Format$(Day(DataNascita) + 40, "00")
    Else
        TxtCodFis = TxtCodFis & Format$(Day(DataNascita), "00")
    End If
    '
    'Località di nascita (BCDE)
    '
    TxtCodFis = TxtCodFis & Provincia$
    '
    'Ultima lettera (F)
    '
    'Controllo caratteri pari
    TempNum = 0
    I = 1
    Do
        ' I DISPARI
        AppoNum =
InStr("B1A0KKPPLLC2QQD3RRE4VVOOSSF5TTG6UUH7MMI8NNJ9WWZZYYXX", Mid(TxtCodFis,
I, 1))
        TempNum = TempNum + ((AppoNum - 1) And &H7FFE) / 2
        I = I + 1
        If I > 15 Then Exit Do
        ' I PARI
        AppoNum =
InStr("A0B1C2D3E4F5G6H7I8J9KKLLMMNNOOPPQQRRSSTTUUVVWWXXYYZZ", Mid(TxtCodFis,
I, 1))
        TempNum = TempNum + ((AppoNum - 1) And &H7FFE) / 2
        I = I + 1
    Loop
    TempNum = TempNum Mod 26
    TxtCodFis = TxtCodFis & Mid$("ABCDEFGHIJKLMNOPQRSTUVWXYZ", TempNum + 1,
1)
    ' Ecco qui il codice bello finito
        Me![txtcodicefiscale] = TxtCodFis
          End If
Ciao da RoDAgo

 Grazie anticipate a chiunque possa aiutarmi.
Io Utilizzo la seguente funzione cod$ alla quale passo come variabili il
cognome (co$), il nome (no$), il codice della citta' (cy$) prelevato da una
combo che a sua volta e' "alimentata" dalla tabella comuni scaricabile dal
sito comune di ICAA, e il sesso (sx$)
'************INGRESSO FUNZIONE*****************
Function cod$(co$, no$, cy$, nt$, sx$)
co$ = UCase$(co$)
no$ = UCase$(no$)
cy$ = UCase$(cy$)
sx$ = UCase$(sx$)
'--------- ELABORAZIONE COGNOME -------------
nominativo co$, 1 ' quest'ultimo: 1 è un flag che indica che sto passando il
cognome
'--------- ELABORAZIONE NOME -------------
nominativo no$, 0  ' quest'ultimo: 0 è un flag che indica che sto passando
il nome
'--------- ELABORAZIONE DATA -------------
codata nt$, sx$
'----------------- ELABORA LETTERA DI CONTROLLO-------------------
ok$=co$ + no$ + nt$ + cy$
miocontrollo ok$
'-----------------------------------------------------------
cod$ = co$ + no$ + nt$ + cy$ + ok$
End Function
'*************************************************************
Sub nominativo(a$, flag)
  noaccenti a$ ' trasforma le vocali accentate in vocali non accentate
  L = Len(a$)
  For i = 1 To L  'ciclo di scansione che separa le vocali dalle consonanti
    ch = Mid(a$, i, 1)
    vc = InStr("AEIOU", ch)
    If vc Then
        vocale = vocale + ch
        Else If ch >= "A" AND ch <= "Z" then consonante = consonante + ch
    EndIf  ' cosi' vengono eliminati anche gli spazi ed eventuali apostrofi
  Next
  Select Case Len(consonante)
    Case Is > 3
      If flag Then a$ = Left(consonante, 3) Else a$ = Left(consonante, 1)+
Mid(consonante, 3, 2)
    Case Is = 3
      a$ = consonante
    Case Is < 3
      a$ = Left(consonante + vocale + "XXX", 3)
  End Select
End Sub
Sub noaccenti(a$)   '(modifica lettre accentate)
    w$ = "": L = Len(a$)
    For i = 1 To L
        ch$ = Mid$(a$, i, 1)
        If ch$ >= "À" And ch$ <= "Å" Then ch$ = "A"
        If ch$ >= "È" And ch$ <= "Ë" Then ch$ = "E"
        If ch$ >= "Ì" And ch$ <= "Ï" Then ch$ = "I"
        If ch$ >= "Ò" And ch$ <= "Ö" Then ch$ = "O"
        If ch$ >= "Ù" And ch$ <= "Ü" Then ch$ = "U"
        w$ = w$ + ch$
    Next
a$ = w$
End Sub
Sub codata(d$, s$)
    If s$ = "M" Then s1 = 0 Else s1 = 40
    ReDim mese$(12)
    mese$(1) = "A": mese$(7) = "L"
    mese$(2) = "B": mese$(8) = "M"
    mese$(3) = "C": mese$(9) = "P"
    mese$(4) = "D": mese$(10) = "R"
    mese$(5) = "E": mese$(11) = "S"
    mese$(6) = "H": mese$(12) = "T"
    anno$ = Right$(d$, 2)
    gior = Val(Left$(d$, 2))
    gior = gior + s1: giorno$ = Format$(gior, "00")
    mes = Val(Mid$(d$, 4, 2))
    d$ = anno$ & mese$(mes) & giorno$
End Sub
Sub miocontrollo(ok$)
    ReDim d(26)
    d(0) = 1: d(1) = 0: d(2) = 5: d(3) = 7
    d(4) = 9: d(5) = 13: d(6) = 15: d(7) = 17
    d(8) = 19: d(9) = 21: d(10) = 2: d(11) = 4
    d(12) = 18: d(13) = 20: d(14) = 11: d(15) = 3
    d(16) = 6: d(17) = 8: d(18) = 12: d(19) = 14
    d(20) = 16: d(21) = 10: d(22) = 22: d(23) = 25
    d(24) = 24: d(25) = 23
' calcolo lettera di controllo
For i = 1 To 15
    If i \ 2 = i / 2 Then pari = True Else pari = False
    ch = Asc(Mid(ok, i, 1))
    v = ch + 65 * (ch > 64 And ch < 91) + 48 * (ch > 47 And ch < 58)
    If pari Then tot = tot + v Else tot = tot + d(v)
Next
ok = Chr(tot Mod 26 + 65)
End Sub
Cosi' io calcolo il codice fiscale
Buon lavoro, ciao
Santini

 Ciao da RoDAgo
Scusa se mi permetto, ma la routine per ricavare le lettere dal cognome a
mio avviso ha un bug.
Mi spego: se l'utente nella form inserisce un cognome tipo Ali' o Bue'
(cioe' con la vocale accentata veramente e non con la vocale seguita
dall'apostrofo) quando la converti in maiuscolo (Cognome$ =
StrConv(Cognome$, vbUpperCase) ) ti ritrovi con la A con la L e con la i
maiuscola accentata (codice ANSI 204). Nel ciclo For... Next vengono prese
in considerazioni solo le vocali non accentate quindi la i maiscola
accentata non viene inclusa nella variabile Vocali e alla fine ti ritrovi
con un cognome codificato come LAX anziche' il corretto LAI (stesso dicasi
per Bue' che diventerebbe BUX anziche' BUE)
Ciao da Santini

 Ciao da Santini
Ciao e tante grazie
RoDAgo