Newsgroup: it.comp.appl.access
Titolo: codice fiscale, riformulo la domanda!

ho una tabella con cognome, nome, data nascita, comune nascita, sesso,
codice fiscale e altro,
vorrei far si che dopo l'inserimento dei dati identificativi e magari con il
codice del calcolo dei codici fiscali che si trova sul sito comune, il campo
del CF mi esca automatico, ho provato a studiare il codice del sito comune,
ma non lo capisco dato che li' i campi non sono associati a niente (solo i
comuni ad una tabella)
qualcuno mi aiuta?
grazie

 wrote in message
Zy6Z6.10771$4J1.1...@news2.tin.it...




Ti riposto la soluzione che ho trovato sul NG (non mi ricordo il nome
del'autore, ma non me ne voglia...)
Partiamo da un controllo chiamato "Comune":
Private Sub Comune_AfterUpdate()
Dim varX As Variant
' prendo i dati da una tabella con l'elenco dei comuni e del
'rispettivo codice erariale (trovato sul sito comune
varX = DLookup("[ISO3]", "ComuniAZ", "[IDComune] = " _
    & Forms!FrmAnaPaz!Comune)
Me![Nazione] = varX
'Il comune è selezionato tramite combobox e aggiorna anche il codice
'erariale necessario per il calcolo del CF
Dim varY As Variant
varY = DLookup("[CodiceErariale]", "ComuniAZ", "[IDComune] = " _
    & Forms!FrmAnaPaz!Comune)
Me![txtCodiceComune] = varY
 Dim ctl As Control
    For Each ctl In Me.Controls
        If ctl.Tag = "x" Then
            If IsNull(ctl) Or ctl = "" Then
                MsgBox "Il campo " & Mid$(ctl.Name, 4) & " non può_
essere vuoto!"
                Exit Sub
            End If
        End If
    Next ctl
'richiama la funzione Calcolo Cod Fis,
'Nella maschera devi avere anche i campi txtCognome, txtNome, DataN
'(data di nascita), cboSesso   e txtCodiceComune (sarebbe il controllo
'dove viene scritto il codice erariale)
 Me.txtCodiceFiscale = CalcoloCodFis(Me.txtCognome, Me.txtNome,
CVDate(Me.DataN), Me.cboSesso, Trim(Me.txtCodiceComune))
End Sub
'questa di seguito e la funzione richiamata che calcola il CF
Private Function CalcoloCodFis(ByVal Cognome$, ByVal Nome$,
DataNascita As Date, Sesso$, Provincia$) As String
    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
Spero di esserti stato utile...
Max

 ha scritto nel messaggio
news:Zy6Z6.10771$4J1.1...@news2.tin.it...
