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)
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:
