Newsgroup: it.comp.appl.access
Titolo: Di nuovo codice fiscale

Scusate se ripresento la questione, ma non riesco a risolvere il
problema con le mie gambine ancora incerte in ACCESS
Sul sito comune c'è una routine per ricavare il famoso CF, ma con
access2000 non vuole saperne di funzionare...
Qualcuno ha qualche soluzione
(ho anche provato a mettere mano al codice, ma con pochi risultati...)
Grazie e Saluti
Max

 ha scritto nel messaggio
news:3b265094...@News.CIS.DFN.DE...

modificato così funziona tranquillamente
Public Function CalcoloCodFis(ByVal Cognome$, ByVal Nome$, DataNascita As
Date, Sesso$, Provincia$) As String
    'Necessita la presenza di 7 textbox con i seguenti nomi:
    'TxtCodFis, TxtCognome, TxtNome, TxtNatoAnno,
    'TxtNatoMese, TxtNatoGiorno, TxtSesso.
    'TxtSesso deve essere uguale a "F" oppure ad "M"
    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
    TxtCodFis = ""
    '
    ' 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 apostrfo 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 apostrfo 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
    CalcoloCodFis = TxtCodFis
End Function
ricordati di verificare i riferimenti a DAO
ciao
Steve

Steve
Grazie
Max