Newsgroup: it.comp.appl.access
Titolo: Evento in pulsante di comando.. non funziona..

ciao a tutti, ho un db e vorrei che alla
pressione del bottone di comando
"Elabora" se trova che il CF
inserito nella casella TxTCodiceFiscale
è già inserito
nel DB mi dia il seguente errore...
purtroppo non funge...
dove sbaglio ????
grazie...
Private Sub cmdElabora_Enter()
Dim x As String
If Me.RecordsetClone.RecordCount = 0 Then
x = MsgBox("Il tizio " & Me!Cerca1 & _
" è già in archivio!", _
vbCritical + vbOKOnly, "Attenzione")
Me!txtCodiceFiscale = ""
Me!txtCodiceFiscale.SetFocus
End If
End Sub

"SuperPippo®" <ik0qd...@SPAMlibero.it> ha scritto nel messaggio
news:Nlx0a.90349$ZE.24...@twister2.libero.it...

Se la tabella che contiene i dati si chiama Tabella1.
Se il campo di Tabella1 che deve contenere il codice fiscale si chiama
Pippo.
Prova così:
Dim x
If DCount("*", "Tabella1", "Pippo= '" _
& Me!txtCodiceFiscale & "'")<> 0 Then
x = MsgBox("Il tizio " & Me!Cerca1 & _
" è già in archivio!", _
vbCritical + vbOKOnly, "Attenzione")
Me!txtCodiceFiscale = Null
Me!txtCodiceFiscale.SetFocus
End If
--
Roberto
---------------------------------------------
il Sito Comune di it.comp.appl.access:
http://www.sitocomune.com
---------------------------------------------

End If
In fase di aggiunta record va bene, ma in caso di modifica di un
record già esistente? (per intenderci, deve modificare l'indirizzo,
non il CF)
A mio avviso meglio un:
***
Private Sub Elabora_Click
Me.RecordsetClone.FindFirst "Pippo = '" _
   & Me.txtCodiceFiscale & "'"
If Me.RecordsetClone.NoMatch Then
   Exit Sub
End If
If Not(Me.NewRecord) Then
   If Me.RecordsetClone.Bookmark = Me.Bookmark Then
      Exit Sub
   End If
End If
... (messaggio CF duplicato)
End Sub
***
Ciao
--
   Alberto
No alla guerra


Tutto dipende da quando il tasto viene premuto.
Normalmente queste verifiche non si effettuano pigiando un pulsante di
comando ma vengono generate a fronte dell'evento "Prima di aggiornare" del
controllo txtCodiceFiscale, e nel caso di esito positivo della ricerca si
annulla l'evento con un Cancel = True.
[CUT]


 End If
-----------------------------
ciao Roberto... provato ma non funge...
ho scritto bene il resto ??
Private Sub cmdElabora_Enter()
Dim x
If DCount("*", "Anagrafe", "TxTCodiceFiscale= '" _
& Me!txtCodiceFiscale & "'") <> 0 Then
x = MsgBox("Il tizio " & Me!Cerca1 & _
" è già in archivio!", _
vbCritical + vbOKOnly, "Attenzione")
Me!txtCodiceFiscale = Null
Me!txtCodiceFiscale.SetFocus
End If
End Sub

 End Sub
Anche tu sei di quelli che pensi che abbia la sfera di cristallo: quando
scrivi che non funziona cosa intendi?
Ti segnala un errore?
Se si quale?
Oppure non fa quello che volevi, nel qual caso dicci cosa fa o non fa.
Dicci anche quando è che pigi il pulsante di comando.


 Dicci anche quando è che pigi il pulsante di comando.
-----------------------
ok..  scusa Roberto sono fortemente distratto in questi giorni...
... cmq... il codice soprariportato non produce alcun errore...
è come se fosse ignorato... vado avanti ed alla fine all'ultimo
controllo CAP mi esce la finestra di default di access che dice
che ho tentato di duplicare i valori dell'indice... in quanto il
controllo TxTCodiceFiscale l'ho messo in chiave primaria...
questo è il quanto.....
--
:<))   SuperPippo®

annulla l'evento con un Cancel = True.
ma quello che io voglio dire è che - ai fini del divieto di
duplicazione - un dato è ok se:
- non è presente in nessun record della tabella
- è presente, ma nel record corrente
Ora se, per esempio, l'utente - in fase di modifica - digita per
errore qualcosa nella casella txtCodiceFiscale e poi riscrive il dato
preesistente riceve un messaggio di errore.
È vero, è un caso limite, ma converrai che sottovalutare la creatività
dell'utente può spesso rivelarsi uno sbaglio.
Ora non ho alcun dubbio sul fatto che tu saprai dosare in maniera
eccellente i vari mesgbox-undo-cancel però la segnalazione di una
duplicazione, che nei fatti non c'è, verrà data e questa susciterà
nell'utente, a seconda del suo grado di preparazione/smaliziatura,
incertezza o ilarità ...


 ha scritto nel messaggio
news:is384vonb5hc54apn...@4ax.com...

Non è assolutamente detto che la segnalazione avvenga nel caso in cui
l'utente vari e poi reinserisca il vecchio codice fiscale; e sufficiente
condizionare il messaggio di errore al fatto che il Value del controllo sia
diverso dall'OldValue: naturalmente va bene anche la verifica che hai fatto
tu, ovvero che si sia in fase di inserimento di un nuovo record o si sta
modificando il record corrente, inserito precedentemente.


 :<))   SuperPippo®
Scusami, ma il pulsante di comando lo pigi? Se si, quando lo pigi?
Perché non generi il codice VBA per la verifica a fronte dell'evento "Prima
di aggiornare" del controllo TxTCodiceFiscale?


 di aggiornare" del controllo TxTCodiceFiscale?
--------------->
no, il pulsante di comando si attiva da solo dato che è in ordine di
tabulazione...sia con Enter che con Tab... e a dir la verità
vorrei escludere la tabulazione con Enter e lasciare solo quella
col Tab...ho provato il codice "Before Update"...
ma non cambia nulla ... nel senso che non da alcun errore...
è come se il codice non lo considerasse proprio...
solo alla fine da quell'errore di access postato in precedenza...
certo che è strano...questo comportamento....
cmq... ecco il codice usato...
Private Sub txtCodiceFiscale_BeforeUpdate(Cancel As Integer)


"SuperPippo®" <ik0qd...@SPAMlibero.it> ha scritto nel messaggio
news:lQb1a.96178$YG2.2...@twister1.libero.it...

Visto che lo generi a fronte dell'evento "Prima di aggiornare" devi
modificarlo così altrimenti potresti avere un messaggio di errore visto che
modifichi il valore di un controllo durante il suo evento "Prima di
aggiornare":
Private Sub txtCodiceFiscale_BeforeUpdate(Cancel As Integer)
Dim x
If DCount("*", "Anagrafe", "TxTCodiceFiscale= '" _
& Me!txtCodiceFiscale & "'") <> 0 Then
x = MsgBox("Il tizio " & Me!Cerca1 & _
" è già in archivio!", _
vbCritical + vbOKOnly, "Attenzione")
Cancel = True
End If
End Sub
Per il fatto che non ricevi alcune segnalazione di errore tramite MsgBox,
sei sicuro che il campo della tabella Anagrafe si chiama TxTCodiceFiscale?


modificando il record corrente, inserito precedentemente.
... azz! ... vecchia volpe ...
vedo di ragionarci un po' su per vedere se alla fine non mi convenga
variare la routine di controllo
È sempre un piacere discutere con te (o anche solo leggere i tuoi
interventi).


 sei sicuro che il campo della tabella Anagrafe si chiama TxTCodiceFiscale?
--------------
diavolo... ho riprovato il tuo codice... ma non cambia nulla....
tutto come prima... chiaramente ho controllato il campo in tabella
ed è scritto esattamente TxTCodiceFiscale
esattamente come ili controllo in maschera ...
questo fatto comincia a diventare un giallo...
non è molto lungo... vuoi che posti il tutto il codice Vba della maschera
???
Ciao...

 Ciao...


 Prova a postarlo.
-----------------------------------------------------
Option Compare Database
Option Explicit
' By:
' Giuseppe Miriello
' 
ik0...@libero.it
' 20.10.01 Adattamento per MSAccess 97 - Giuseppe Miriello
Public DB  As Database
Public COMUNI As Recordset
Private Sub cboSesso_BeforeUpdate(Cancel As Integer)
End Sub
Private Sub Cerca1_AfterUpdate()
Me.Requery
End Sub
Private Sub Cerca1_KeyPress(KeyAscii As Integer)
KeyAscii = MkUpper(KeyAscii)
End Sub
Private Sub Cerca2_KeyPress(KeyAscii As Integer)
KeyAscii = MkUpper(KeyAscii)
End Sub
Private Sub CMDButton_Click()
Dim Criteria As String
Criteria = ""
If Not IsNull(Me!Cerca1) Then
    Criteria = "TxtCognome=" & Chr$(34) & _
    Me!Cerca1 & Chr$(34)
End If
If Not IsNull(Me!Cerca2) Then
    If Criteria <> "" Then
        Criteria = Criteria & " AND "
    End If
    Criteria = Criteria & "TxtNome=" & Chr$(34) & _
    Me!Cerca2 & Chr$(34)
End If
If Not IsNull(Me!Cerca3) Then
    If Criteria <> "" Then
        Criteria = Criteria & " AND "
    End If
    Criteria = Criteria & "TxtDataNascita= #" & _
    Format(Me!Cerca3, "mm/dd/yyyy") & "#"
End If
If Not IsNull(Me!Cerca4) Then
    If Criteria <> "" Then
        Criteria = Criteria & " AND "
    End If
    Criteria = Criteria & "[N_Protocollo] Like" & _
        Chr$(34) & Me!Cerca4 & Chr$(34)
End If
Me.Filter = Criteria
Me.FilterOn = True
End Sub
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))
SendKeys "{TAB}", True
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyReturn
End Select
End Sub
Private Sub Form_Load()
    DoCmd.GoToRecord , , acNewRec
    Me!N_Protocollo.SetFocus
    On Error GoTo ErrFas
    Set DB = CurrentDb
    Set COMUNI = DB.OpenRecordset("Comuni")
    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
    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 = ""
    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
        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
    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
        End If
    Next I
    If Len(Consonanti) >= 4 Then
        Consonanti = Left$(Consonanti, 1) & mID$(Consonanti, 3, 2)
    ElseIf Len(Consonanti) = 3 Then
    Else
        Consonanti = Left$(Consonanti & Vocali, 3)
        If Len(Consonanti) < 3 Then Consonanti = Left$(Consonanti & "XXX",
3)
    End If
    TxtCodFis = TxtCodFis & Consonanti
    TxtCodFis = TxtCodFis + Right(Format$(Year(DataNascita), "0000"), 2)
    TxtCodFis = TxtCodFis & mID$("ABCDEHLMPRST", Month(DataNascita), 1)
    If UCase(SESSO$) = "F" Then
        TxtCodFis = TxtCodFis & Format$(Day(DataNascita) + 40, "00")
    Else
        TxtCodFis = TxtCodFis & Format$(Day(DataNascita), "00")
    End If
    TxtCodFis = TxtCodFis & Provincia$
    TempNum = 0
    I = 1
    Do
        AppoNum =
InStr("B1A0KKPPLLC2QQD3RRE4VVOOSSF5TTG6UUH7MMI8NNJ9WWZZYYXX", mID(TxtCodFis,
I, 1))
        TempNum = TempNum + ((AppoNum - 1) And &H7FFE) / 2
        I = I + 1
        If I > 15 Then Exit Do
        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)
    CalcoloCodFis = TxtCodFis
End Function
Private Sub Testo22_KeyPress(KeyAscii As Integer)
KeyAscii = MkUpper(KeyAscii)
End Sub
Private Sub txtCodiceFiscale_BeforeUpdate(Cancel As Integer)
Dim x
If DCount("*", "Anagrafe", "TxTCodiceFiscale= '" _
& Me!txtCodiceFiscale & "'") <> 0 Then
x = MsgBox("Il tizio " & Me!Cerca1 & _
" è già in archivio!", _
vbCritical + vbOKOnly, "Attenzione")
Cancel = True
End If
End Sub
Private Sub txtCognome_KeyPress(KeyAscii As Integer)
KeyAscii = MkUpper(KeyAscii)
End Sub
Private Sub PulsanteCMD_DblClick(Cancel As Integer)
Dim Criteria As String
Criteria = ""
If Not IsNull(Me!Cerca1) Then
    Criteria = "TxtCognome=" & Chr$(34) & _
    Me!Cerca1 & Chr$(34)
End If
If Not IsNull(Me!Cerca2) Then
    If Criteria <> "" Then
        Criteria = Criteria & " AND "
    End If
    Criteria = Criteria & "TxtNome=" & Chr$(34) & _
    Me!Cerca2 & Chr$(34)
End If
If Not IsNull(Me!Cerca3) Then
    If Criteria <> "" Then
        Criteria = Criteria & " AND "
    End If
    Criteria = Criteria & "TxtDataNascita= #" & _
    Format(Me!Cerca3, "mm/dd/yyyy") & "#"
If Not IsNull(Me!Cerca4) Then
    If Criteria <> "" Then
        Criteria = Criteria & " AND "
    End If
    Criteria = Criteria & "[N_Protocollo] Like" & _
        Chr$(34) & Me!Cerca4 & Chr$(34)
End If
Me.Filter = Criteria
Me.FilterOn = True
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 txtComune_KeyPress(KeyAscii As Integer)
KeyAscii = MkUpper(KeyAscii)
End Sub
Private Sub txtNome_KeyPress(KeyAscii As Integer)
    Dim strCarattere As String
    strCarattere = Chr(KeyAscii)
    KeyAscii = Asc(UCase(strCarattere))
End Sub
Private Sub txtProvincia_BeforeUpdate(Cancel As Integer)
End Sub
Private Sub Comando104_Click()
On Error GoTo Err_Comando104_Click
    Screen.PreviousControl.SetFocus
    DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70
Exit_Comando104_Click:
    Exit Sub
Err_Comando104_Click:
    MsgBox Err.Description
    Resume Exit_Comando104_Click
End Sub
Private Sub Comando109_Click()
On Error GoTo Err_Comando109_Click
    Screen.PreviousControl.SetFocus
    DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70
Exit_Comando109_Click:
    Exit Sub
Err_Comando109_Click:
    MsgBox Err.Description
    Resume Exit_Comando109_Click
End Sub
Private Sub PRN_UT_Click()
On Error GoTo Err_PRN_UT_Click
    Dim stDocName As String
    stDocName = "Stampa Utente"
    DoCmd.OpenReport stDocName, acNormal
Exit_PRN_UT_Click:
    Exit Sub
Err_PRN_UT_Click:
    MsgBox Err.Description
    Resume Exit_PRN_UT_Click
End Sub
Private Sub Erase_Click()
On Error GoTo Err_Erase_Click
    DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
    DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70
Exit_Erase_Click:
    Exit Sub
Err_Erase_Click:
    MsgBox Err.Description
    Resume Exit_Erase_Click
End Sub
Private Sub Exit_Click()
On Error GoTo Err_Exit_Click
    DoCmd.close
Exit_Exit_Click:
    Exit Sub
Err_Exit_Click:
    MsgBox Err.Description
    Resume Exit_Exit_Click
End Sub