[MS Access] aiuto non riesco a capire

Stato
Chiusa ad ulteriori risposte.

dario21

Nuovo Utente
19 Feb 2019
9
0
1
roma
stavo svolgendo questo piccolo esercizio preso da internet su access 2003 non mi da problemi mentre su access 2007 si potreste aiutarmi a capire cosa c'e' che non va?
vi ringrazio anticipatamente
vostro affezzionato dario(new entry) :)
Codice:
Option Compare Database
Option Explicit


Public DB  As Database
Public COMUNI As Recordset

Private Sub cmdElabora_Click()
    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
    Me.txtCodiceFiscale = CalcoloCodFis(Me.txtCognome, Me.txtNome, CVDate(Me.txtDataNascita), Me.cboSesso, Trim(Me.txtCodiceComune))
End Sub

Private Sub cmdEsci_Click()
    DoCmd.Close acForm, Me.Name
End Sub

Private Sub Comando18_Click()
Me.txtCodiceComune = ""
Me.txtCodiceFiscale = ""
Me.txtCognome = ""
Me.txtComune = ""
Me.txtDataNascita = ""
Me.txtNome = ""
Me.txtProvincia = ""
Me.txtCognome.SetFocus
End Sub

Private Sub Corpo_Click()

End Sub

Private Sub Form_Load()
    On Error GoTo ErrFas
    Set DB = CurrentDb
    Set COMUNI = DB.OpenRecordset("Comunifis")
    COMUNI.Index = "COMUNI2L"
    Exit Sub
ErrFas:
    MsgBox ("FasMsg: " & Err.Number & " " & Err.Description)
    Err.Clear
End Sub

Private 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

Private Sub Form_Unload(Cancel As Integer)
    'COMUNI.Close
    'Set DB = Nothing
    'DoCmd.Quit acQuitSaveNone
End Sub

Private Sub txtCognome_Click()

End Sub

Private Sub txtCognome_KeyPress(KeyAscii As Integer)
    Dim strCarattere As String
    strCarattere = Chr(KeyAscii)
    KeyAscii = Asc(UCase(strCarattere))
End Sub

Private Sub txtComune_Change()
    Dim S As String
    Dim T As String
    Dim Colore As Long
    On Error GoTo ErrFas

    Colore = 0

    T = Trim(Nz(Me.txtComune.Text, ""))
    If T = "" Then
        Me.txtComune.Tag = T
        Exit Sub
    End If
    If Len(T) = 1 Then S = T
    COMUNI.Seek ">=", T
    If Not COMUNI.EOF And Not COMUNI.NoMatch Then
      If UCase(T) = UCase(Mid(COMUNI!COMU_DESCR, 1, Len(T))) Then
        If Len(T) > Len(Me.txtComune.Tag) Then
            Me.txtComune = COMUNI!COMU_DESCR
            Me.txtComune.SelStart = Len(T)
            Me.txtComune.SelLength = Len(Me.txtComune) - (Len(T))
            Me.txtProvincia = COMUNI!COMU_PROV
            Me.txtCodiceComune = COMUNI!COMU_COD
        End If
      Else
        If Me.txtComune.ForeColor = 0 Then MsgBox "Comune non in elenco"
        Colore = &H80&
        Me.txtProvincia = ""
        Me.txtCodiceComune = ""
        Me.txtComune.SetFocus
      End If
    End If

    If Me.txtComune.ForeColor <> Colore Then Me.txtComune.ForeColor = Colore

    Me.txtComune.Tag = T
Exit Sub
ErrFas:
    MsgBox ("FasMsg: " & Err.Number & " " & Err.Description)
    Err.Clear
End Sub

Private Sub txtNome_KeyPress(KeyAscii As Integer)
    Dim strCarattere As String
    strCarattere = Chr(KeyAscii)
    KeyAscii = Asc(UCase(strCarattere))
End Sub
 
Ultima modifica di un moderatore:

Max 1

Super Moderatore
Membro dello Staff
SUPER MOD
MOD
29 Feb 2012
4.197
312
83
@dario21
Da regolamento del forum, come tutti noi sei tenuto ad usare il tag
code.gif
quando posti del codice, oppure la funzione codice dalla barra degli strumenti
box inserisci 2.png.JPG

Inoltre ti prego di leggere attentamente il regolamento generale del forum e quello di sezione dove posti
Grazie
Per questa volta te lo sistemo io ma mi raccomando per il futuro
 

dario21

Nuovo Utente
19 Feb 2019
9
0
1
roma
@dario21
Da regolamento del forum, come tutti noi sei tenuto ad usare il tag Vedi l'allegato 6115 quando posti del codice, oppure la funzione codice dalla barra degli strumenti
Vedi l'allegato 6116
Inoltre ti prego di leggere attentamente il regolamento generale del forum e quello di sezione dove posti
Grazie
Per questa volta te lo sistemo io ma mi raccomando per il futuro
scusami non sono molto pratico sei davvero gentile grazie ancora
 

CarlettoFed

Utente Attivo
17 Lug 2017
82
1
8
66
Per darti una risposta devi postare su un sito di condivione file il database e poi mostrare qui il link, altrimenti sarà difficile aiutarti.
 

dario21

Nuovo Utente
19 Feb 2019
9
0
1
roma
buongiorno a tutti e scusatemi se non sono stato molto attivo in questi giorni :)
innanzitutto volevo ringraziarvi per la disponibilità offerta e fortunatamente sono riuscito a risolvere il problema pero adesso me ne sorge uno nuovo con una maschera cosa devo fare aprire una nuova discussione o posso postare qui il problema?
 

Max 1

Super Moderatore
Membro dello Staff
SUPER MOD
MOD
29 Feb 2012
4.197
312
83
Prosegui qui!
 
Stato
Chiusa ad ulteriori risposte.