Errore in ricerca CBO

[FrasubbPartecipante Frasubb Karma: 1 pt]

Ciao  a tutti,

avrei bisogno di risolvere un piccolo problema, nel senso che quando vado a ricercare e poi selezionare un record tramite la "cboRicerca" dalla userfom1, in quest'ultima mi compaiono solo i dati del primo record in elenco e se ne vado a selezionare un altro mi rimangono in maschera sempre gli stessi.

Oltretutto, approfitto, mi occorrerebbe far comparire anche i dati, sempre nella userform1, relativi alle textbox "TxtCodfisc" e "TxtTelefono".

Se possibile, far funzionare lo scroll del mouse all'interno della finestra di ricerca "cboRicerca" perché al momento non da segni di vita.

Allego file esempio

Grazie in anticipo a chi vorrà aiutarmi !!

Allegati:

You must be logged in to view attached files.

[alexps81Moderatore alexps81 Karma: 58 pts]

Frasubb ha scritto:

avrei bisogno di risolvere un piccolo problema

In realtà di problemi ne hai diversi...

1) Già in altre occasioni ti sempre detto che in cima ad ogni Modulo Standard, ad ogni UserForm, ad ogni evento dei Fogli...devi sempre mettere Option Explicit. Se vuoi evitare di dimenticartelo basta che ti porti nell'editor del VBA e selezioni Strumenti --> Opzioni --> Editor e spunti la casella Dichiarazioni di variabili obbligatoria. Ovviamente funzionerà dal momento in cui aggiungerai una nuova UserForm o Modulo. In quelli già esistenti dovrai scriverlo manualmente.

Se lo farai ti accorgerai che ti verranno segnalati tutti gli errori che commetti quando non dichiari una variabile o la dichiari più di una volta nella stessa routine. Oppure un oggetto (TextBox, ComboBox, ecc...) non esiste anche se lo invochi. Per esempio nella UserForm1 è ancora presente questo pezzo di codice:

If CboNumRate > 1 Then 'N
    arr(nRows, 14) = "PDR"
Else
    arr(nRows, 14) = "UNI"
End If

ma l'oggetto CboNumRate non esiste in esso. Senza Option Explicit non ti viene segnalato ma è un errore ignorarlo. Infatti ad ogni inserimento di un nuovo nominativo, la colonna "N" viene sempre e solo popolata con la scritta "UNI".

2) Per quanto riguarda la CboRicerca...per prima cosa devi caricarli bene i dati. Nella UserFrom1 aggiungi questa macro (è commentata quindi cerca di capirne il senso):

Private Sub caricacomboRicerca()
    Dim ur As Long, i As Long
    
    ur = Cells(Rows.Count, "A").End(xlUp).Row
    
    If ur < 2 Then Exit Sub '<--se non sono presenti nominativi allora non caricare nulla
    
    With cboRicerca
        .Clear
        .ColumnCount = 2 '<--imposto la ComboBox a 2 colonne
        .ColumnWidths = "0 pt" '<--la prima colonna non la mostro
        For i = 2 To ur
            .AddItem i '<--carico in colonna 1 della ComboBox il numero di riga in modo da poterlo sfruttare al momento di eventuali modifiche/eliminazioni/caricamenti
            .List(.ListCount - 1, 1) = Cells(i, "A").Value & " " & Cells(i, "B").Value '<--carico in colonna 2 il contatore ed il nominativo
        Next i
    End With
End Sub

poi tutto quello che hai scritto nell'evento Initialize della UserForm1 lo sostituisci con questo:

Private Sub UserForm_Initialize()
    caricacomboRicerca
End Sub

ti faccio fare questo perché quando ti capiterà di dover inserire un nuovo nominativo, allora dovrai aggiornare anche la cboRicerca. Se invece lasci che il caricamento avvenga solo tramite evento Initialize, succederà che ogni volta sarai costretto a chiudere e riaprire la UserForm1.

Infatti ora per chiudere il cerchio dovrai aggiungere in Private Sub cmdInvia_Click() questa linea di codice:

caricacomboRicerca

la metti verso la fine della Sub...in mezzo tra Call cmdReset_Click e On Error Resume Next

3) Adesso veniamo al popolamento di ogni TextBox e ComboBox al momento che scegli un nominativo dalla cboRicerca...

sostituisci ciò che hai scritto il Private Sub cboRicerca_Click() con questo:

Private Sub cboRicerca_Click()
    Dim r As Long
    
    blLoad = True '<--serve ad evitare il Loop negli eventi Change degli oggetti in UserForm
    r = cboRicerca.Value
    
    TxtContatore = Cells(r, "A").Value
    TxtCliente = Cells(r, "B").Value
    TxtDataOper = CDate(Cells(r, "C").Value)
    TxtMandato = Cells(r, "E").Value
    TxtScadPag = CDate(Cells(r, "F").Value)
    TxtDebOrigin = Format(CDbl(Cells(r, "H").Value), "#,##.00")
    TxtAccord = Format(CDbl(Cells(r, "I").Value), "#,##.00")
    TxtNumRate = Cells(r, "J").Value
    TxtDaPag = Format(CDbl(Cells(r, "L").Value), "#,##.00")
    TxtModalPag = Cells(r, "N").Value
    TxtDirLiber = Cells(r, "P").Value
    TxtCodfisc = Cells(r + 1, "B").Value
    TxtTelefono = Cells(r + 1, "C").Value
    
    blLoad = False
End Sub

4) Se noti bene, in questo ultimo codice è presente la variabile Booleana blLoad. Questa è utile per evitare di far scattare il Change ad ogni TextBox e ComboBox nell'UserForm1. In altre parole...ogni volta che tu andrai a popolare questi oggetti, scattano questi Change:

Private Sub TxtAccord_Change()
Private Sub TxtCliente_change()
Private Sub TxtCodfisc_Change()
Private Sub TxtContatore_Change()
Private Sub TxTDataOper_Change()
Private Sub TxtDebOrigin_Change()
Private Sub TxtMandato_Change()
Private Sub TxtDirLiber_Change()
Private Sub TxtScadPag_Change()
Private Sub TxtTelefono_Change()

Siccome non serve farli scattare ad ogni caricamento, utilizziamo la variabile blLoad per bloccare gli eventi Change.

Quindi in cima a tutto il codice scritto nella UserForm1, alla riga sotto ad Option Explicit, che spero tu ormai abbia messo, ci aggiungi:

Private blLoad As Boolean

poi in tutti gli eventi Change delle varie TextBox che ti ho su indicato ci devi aggiungere:

If blLoad Then Exit Sub

ad esempio Private Sub TxtContatore_Change() lo trasformi in:

Private Sub TxtContatore_Change()
    If blLoad Then Exit Sub

    Me.TxtContatore.MaxLength = 8
End Sub

P.S. Ti consiglio di gestire la lunghezza massima consentita in una TextBox direttamente nelle Proprietà dell'oggetto e non nell'evento Change. Se ad esempio selezioni la TxtContatore, nel riquadro a sinistra troverai tre le varie, la proprietà MaxLength. Lì indichi direttamente il numero 8. A quel punto puoi fare a meno di codificarlo tramite evento Change. Stessa cosa per tutte le altre TextBox in cui vuoi ottenere lo stesso risultato.

5) Ulteriore consiglio nella Private Sub cmdInvia_Click(). Quello che hai scritto qui:

If cboRicerca <> "" Then
    MsgBox "Attenzione ! Record duplice", vbCritical, "Alert"
    Call cmdReset_Click
    ActiveSheet.Cells(2, 2) = TxtCliente.Text
    Exit Sub
End If

non ha alcun senso. Questo metodo non ti consente di verificare con esattezza che stai inserendo per errore un record già esistente. Se tu selezioni un nominativo, poi cancelli con il tasto CANC quello che hai scelto nella cboRicherca, succederà che il pezzo di codice che hai scritto fallirà, in quanto  cboRicerca non è <> da ""

Per ottenere il risultato da te sperato devi fare così: cancelli quel pezzo di codice e lo sostituisci con questo:

    If Trim(TxtContatore.Value) = "" Then Exit Sub
    
    If controllaDuplicato(CLng(TxtContatore.Value)) Then
        MsgBox "Attenzione ! Record duplice", vbCritical, "Alert"
        Call cmdReset_Click
    End If

poi al di fuori della macro Private Sub cmdInvia_Click(), ci metti questa Function:

Private Function controllaDuplicato(ByVal nContatore As Long) As Boolean
    controllaDuplicato = Not Range("A:A").Find(What:=nContatore, _
                                               LookAt:=xlWhole, _
                                               LookIn:=xlValues) Is Nothing
End Function

Come puoi notare, quando vai ad inserire un nuovo nominativo, verrà richiamata la Function controllaDuplicato la quale esegue una ricerca del numero del Contatore in colonna "A". Se lo trova allora vuol dire che già esiste e ti blocca l'inserimento.

[LukeRedsPartecipante LukeReds Karma: 19 pts]

ciao

errore di fondo nel tuo file, nel foglio gennaio (e immagino valga per tutti i mesi) metti 2 dati diversi nella stessa colonna (la C, telefono e data). 1 colonna 1 dato, perchè mischiare dati differenti?

Altra cosa, il codice di cancellazione puà essere sostituito da 1 sola istruzione. Tra l'altro ogni volta che cancelli un contenuto viene chiamata la sub worksheet_change quindi

Application.EnableEvents = False
Range("A2:D201,F2:H201,J1:Q201").ClearContents
' anche Union(Range("A2:D201"), Range("F2:H201"), Range("J1:Q201"))
Application.EnableEvents = true

tuo codice

 

`Range("A2:A201").Select
Selection.ClearContents
Range("B2:B201").Select
Selection.ClearContents
Range("C2:C201").Select
Selection.ClearContents
Range("D2:D201").Select
Selection.ClearContents
Range("E2:F201").Select
Selection.ClearContents
Range("G2:G201").Select
Selection.ClearContents
Range("H2:I201").Select
Selection.ClearContents
Range("J2:J201").Select
Selection.ClearContents
Range("K2:K201").Select
Selection.ClearContents
Range("L2:L201").Select
Selection.ClearContents
Range("M2:M201").Select
Selection.ClearContents
Range("N2:N201").Select
Selection.ClearContents
Range("O2:O201").Select
Selection.ClearContents
Range("P2:P201").Select
Selection.ClearContents
Range("Q2:S201").Select
Selection.ClearContents`

 

 

[FrasubbPartecipante Frasubb Karma: 1 pt]

grande @alexps81, 

la tua opera è sempre sontuosa ... Grazie !

Volevo dire solo due cose:

Private Function controllaDuplicato(ByVal nContatore As Long) As Boolean
    controllaDuplicato = Not Range("A:A").Find(What:=nContatore, _
                                               LookAt:=xlWhole, _
                                               LookIn:=xlValues) Is Nothing
End Function

queste righe non le ho inserite perché mi serve che non ci sia questo blocco, ci può essere talvolta la necessità di inserire doppiamente un numero di contatore.

Detto ciò, è tutto perfetto, solo che non mi funziona bene il tasto "modifica" per andare eventualmente a modificare un record; qui di seguito inserisco il codice che ho, mentre il file è valido quello allegato nella #54369

Private Sub cmdModifica_Click()
Dim Risp As String
Risp = MsgBox("Confermi modifica?", vbYesNo + vbQuestion, "Alert")
If Risp = vbNo Then
Call cmdReset_Click

    Exit Sub
End If


ActiveCell.Value = TxtContatore
ActiveCell.Offset(0, 1).Value = TxtCliente
ActiveCell.Offset(0, 2).Value = TxtDataOper
ActiveCell.Offset(0, 4).Value = TxtMandato
ActiveCell.Offset(0, 5).Value = TxtScadPag
ActiveCell.Offset(0, 7).Value = CDbl(TxtDebOrigin)
ActiveCell.Offset(0, 8).Value = CDbl(TxtAccord)
ActiveCell.Offset(0, 9).Value = CDbl(TxtNumRate)
ActiveCell.Offset(0, 11).Value = CDbl(TxtDaPag)
ActiveCell.Offset(0, 16).Value = TxtDirLiber
ActiveCell.Offset(0, 18).Value = TxtModalPag

 
Call cmdReset_Click

End Sub

[alexps81Moderatore alexps81 Karma: 58 pts]

Frasubb ha scritto:

la tua opera è sempre sontuosa ... Grazie !

Grazie a te per feedbeack.

Frasubb ha scritto:

non mi funziona bene il tasto "modifica"

Be' ovvio che sia così. Adesso tutta la logia è diversa. Non stiamo più lavorando sulla cella attiva (ActiveCell)...però sai che ti dico? Trattiamolo in un nuovo argomento   

[alexps81Moderatore alexps81 Karma: 58 pts]

@frasubb dovresti effettuare questa modifica alla Private Sub caricacomboRicerca()

Sostituisci questo pezzo:

        For i = 2 To ur
            .AddItem i '<--carico in colonna 1 della ComboBox il numero di riga in modo da poterlo sfruttare al momento di eventuali modifiche/eliminazioni/caricamenti
            .List(.ListCount - 1, 1) = Cells(i, "A").Value & " " & Cells(i, "B").Value '<--carico in colonna 2 il contatore ed il nominativo
        Next i

con questo:

        For i = 2 To ur
            If i Mod 2 = 0 Then
                .AddItem i '<--carico in colonna 1 della ComboBox il numero di riga in modo da poterlo sfruttare al momento di eventuali modifiche/eliminazioni/caricamenti
                .List(.ListCount - 1, 1) = Cells(i, "A").Value & " " & Cells(i, "B").Value '<--carico in colonna 2 il contatore ed il nominativo
            End If
        Next i

In pratica dobbiamo saltare le righe dispari quando carichiamo i dati in Combobox. Lo facciamo grazie all'operatore MOD.

[FrasubbPartecipante Frasubb Karma: 1 pt]

In pratica dobbiamo saltare le righe dispari quando carichiamo i dati in Combobox. Lo facciamo grazie all'operatore MOD

 ok perfetto, grazie !

 Sarebbe possibile, per una più comoda e veloce ricerca del nominativo, far sì che basti scrivere le prime lettere del cognome nella combobox così da individuarlo e selezionarlo ?

 Lo scroll del mouse si può rendere funzionante ?

 Grazie @alexps81

 

 

[alexps81Moderatore alexps81 Karma: 58 pts]

Frasubb ha scritto:

Sarebbe possibile, per una più comoda e veloce ricerca del nominativo, far sì che basti scrivere le prime lettere del cognome nella combobox così da individuarlo e selezionarlo ?

Onestamente non trovo molto utile ciò che tu voglia ottenere. Mi sorge una dubbio e per questo la domanda è spontanea...ma quanti nominativi accoglierà più o meno la ComboBox CboRicherca? Diciamo che già quando superi 20/30 elementi stai andando al di fuori della sua vera natura. Fare delle ricerche in una ComboBox con così tanti elementi lo trovo "scomodo".

Tu dici giustamente:

Frasubb ha scritto:

scrivere le prime lettere del cognome nella combobox così da individuarlo e selezionarlo

ma perché?? Per far queste cose c'è la ListBox che abbinata ad una TextBox di ricerca fa proprio ciò che chiedi ed in modo più professionale. Quindi nel digitare le lettere del nominativo da cercare nella TextBox txtRicerca...vedresti man mano nella ListBox filtrare i nominativi. Non so...pensaci...secondo me è la scelta più giusta (neanche a dirlo...da trattare eventualmente in una  nuova richiesta).

Frasubb ha scritto:

 Lo scroll del mouse si può rendere funzionante ?

No purtroppo nativamente non è possibile. Magari tramite utilizzo di API Windows ma è un terreno ostico e pieno di insidie...te lo sconsiglio.

Purtroppo il fatto è che tu stai cercando di realizzare un gestionale che per sua natura andrebbe realizzato in Access.

[FrasubbPartecipante Frasubb Karma: 1 pt]

@alexps81  ....

ma quanti nominativi accoglierà più o meno la ComboBox CboRicherca?

minimo 60 record

Non so...pensaci...secondo me è la scelta più giusta

ovviamente seguo ciò che mi consigli, quindi grazie innanzitutto e poi ho aperto nuova discussione in merito

[Autore]

Articoli