ciao mi presento

[dario21]

Salve sono Dario 21 anni autodidatta su access o meglio non potendomi permettere corsi costosi cerco di "rubare" a chi ne sa più di me............. ne approfitto per questo quesito che già so vi farà ridere a tutti ma abbiate un po di pazienza e forse un giorno anche io grazie al vostro aiuto spero di poter essere utile qualcuno

questo e un piccolo esercizio che preso su youtube
perche sulla versione access 2010 non gira?
sulla 2003 funziona
cosa sbaglio???

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

 

[Max 1]

@dario21
Questo non è il posto per consigli o altro qui si ci presenta al forum e basta