[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.449
338
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
101
1
18
70
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?
 
Stato
Chiusa ad ulteriori risposte.
Discussioni simili
Autore Titolo Forum Risposte Data
T mysql tutorial per importare tabelle access in mysql aiuto MySQL 2
G Aiuto su combo box di access MS Access 0
A Aiuto, query per Access 2003 MS Access 5
S aiuto maschere access MS Access 1
P Access: recuperare Indice dopo un insert into MS Access 0
N Access: Filtro su maschera MS Access 0
B Non riesco a trovare i cognomi con i caratteri speciali in Access (Microsoft 365) MS Access 0
N Errore interno Access MS Access 2
C ACCESS Aprire maschera se valore non presente in una combo MS Access 7
L Access Periodo maschera continua MS Access 4
B Aumento dimensioni grafico Access Database 0
R [C#] Quali dipendenze occorrono su progetto "Setup" con Access Database? .NET Framework 1
G Appicazione HTML per inserimento dai in Database Access Microsoft HTML e CSS 0
K mc Access/phpmyamin MS Access 0
L Collegare un form html ad un database access Javascript 2
R salve a tutti sono un insegnante di pianoforte e a tempo perso mi sto dedicando ad access Presentati al Forum 1
G Access point con rete guest, consigli? Reti LAN e Wireless 0
P Access Inserimento data. MS Access 4
ges Microsoft ACCESS oltre ogni limite (tre manuali) Altri Annunci 2
@ [MS Access] Funzione Iif..is null... Database 0
P [MS Access] Sostituire un carattere in tutta la tabella MS Access 11
B tasti rapidi Access MS Access 1
M [MS Access] Pulsante su maschera che esegue azioni su altra maschera MS Access 3
C [MS Access] Pagina di dialogo con allegati MS Access 1
F Modificare report di etichette di access con vba MS Access 0
strambotto [MS Access] Smembramento tabella MS Access 5
D [MS Access] Piu' maschere con una sola tabella dati... MS Access 0
G [MS Access] Funzione ARROTONDA non definita nell'espressione MS Access 1
Spenalzo Creare tabelle multiple con Access via VBA MS Access 2
M [MS Access] Relazione tra maschere MS Access 1
G Access Point POE da esterno Reti LAN e Wireless 0
M [MS Access] controllo valido se MS Access 8
N [MS Access] Come relazionare DB Libri trasposti in Film e viceversa MS Access 1
S [ASP] SALVARE VALORE SELECT OPTION SU CAMPO TABELLA ACCESS Classic ASP 9
D [MS Access] MS Access 2
S [MS Access] Apertura Maschera su nuov record in base a determinato ID MS Access 0
maria_ia Microsoft Access Windows e Software 0
S [MS Access] Apertura maschera MS Access 3
S [MS Access] trasformare un numero in lettere in un report MS Access 1
D [Visual Basic] [MS Access] query con parametro di testo Visual Basic 4
P [MS ACCESS] Estrarre più somme da una query MS Access 4
D [MS Access] problemi con inserimento campo in una maschera MS Access 6
F [MS Access] Creare [stringa] da caselle combinate MS Access 0
Arcadia [MS Access] Focus su campo specifico MS Access 1
akira [MS Access] Apertura recordset MS Access 1
V access 2007, maschera con caselle di selezione Programmazione 4
W [MS Access] Barre di scorrimento su maschere MS Access 0
A [MS Access] Pulsante per inserire allegati in campo maschera MS Access 0
J [MS Access] Filtro su combo in sottomaschera MS Access 11
Arcadia [MS Access] Implementazione progetto con nuove funzioni. MS Access 0

Discussioni simili