[MS Access] aiuto non riesco a capire

Discussione in 'MS Access' iniziata da dario21, 19 Febbraio 2019.

Status Discussione:
Chiusa ad ulteriori risposte.
  1. dario21

    dario21 Nuovo Utente

    Registrato:
    19 Febbraio 2019
    Messaggi:
    9
    Mi Piace Ricevuti:
    0
    Punteggio:
    1
    Sesso:
    Maschio
    Occupazione:
    commesso part time
    Località:
    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: 19 Febbraio 2019
  2. Max 1

    Max 1 Super Moderatore Membro dello Staff SUPER MOD MOD

    Registrato:
    29 Febbraio 2012
    Messaggi:
    3.798
    Mi Piace Ricevuti:
    283
    Punteggio:
    83
    Sesso:
    Maschio
    @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
     
  3. dario21

    dario21 Nuovo Utente

    Registrato:
    19 Febbraio 2019
    Messaggi:
    9
    Mi Piace Ricevuti:
    0
    Punteggio:
    1
    Sesso:
    Maschio
    Occupazione:
    commesso part time
    Località:
    roma
    scusami non sono molto pratico sei davvero gentile grazie ancora
     
  4. CarlettoFed

    CarlettoFed Utente Attivo

    Registrato:
    17 Luglio 2017
    Messaggi:
    74
    Mi Piace Ricevuti:
    1
    Punteggio:
    8
    Sesso:
    Maschio
    Per darti una risposta devi postare su un sito di condivione file il database e poi mostrare qui il link, altrimenti sarà difficile aiutarti.
     
  5. marino51

    marino51 Utente Attivo

    Registrato:
    28 Febbraio 2013
    Messaggi:
    2.518
    Mi Piace Ricevuti:
    123
    Punteggio:
    63
    Occupazione:
    free lance
    Località:
    Lombardia
    magari se specificassi il problema incontrato, sarebbe un grande aiuto a chi t'aiuta
     
  6. dario21

    dario21 Nuovo Utente

    Registrato:
    19 Febbraio 2019
    Messaggi:
    9
    Mi Piace Ricevuti:
    0
    Punteggio:
    1
    Sesso:
    Maschio
    Occupazione:
    commesso part time
    Località:
    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?
     
  7. Max 1

    Max 1 Super Moderatore Membro dello Staff SUPER MOD MOD

    Registrato:
    29 Febbraio 2012
    Messaggi:
    3.798
    Mi Piace Ricevuti:
    283
    Punteggio:
    83
    Sesso:
    Maschio
    Prosegui qui!
     
Sto caricando...
Status Discussione:
Chiusa ad ulteriori risposte.

Condividi questa Pagina