MacroFacili: UserForm di ricerca

Una UserForm per effettuare una ricerca incrementale, nel nostro esempio in un archivio di clienti.

Cominciando a scrivere parte del nome nella cella del testo da cercare l'elenco dei clienti corrispondenti si ridurrà di numero in modo da trovare più facilmente quello desiderato.

Il nominativo può essere selezionato e confermato con il bottone o semplicemente con il doppio-click.

Il codice della risposta al click del bottone di ricerca sarà semplicemente l'impostazione della cella in cui deve essere riportato il codice e l'attivazione delle finestra.

Sub Ricerca()
UfRicerca.CellaCodice Sheets("Es435").Range("B3")
UfRicerca.Show
End Sub

l'esempio completo é scaricabile da questo link: Es435.xlsm (a questo link le info per attivare le macro se risultano bloccate)

Il codice della UserForm

La definizione del vettore dinamico che contiene l'insieme dei valori possibili come variabile globale e della variabile che contiene la cella di destinazione.

Dim Clienti() As Variant
Dim pCellaDest As Range

Sub CellaCodice(Cella As Range)
Set pCellaDest = Cella
End Sub

La parte di codice che viene eseguito quando la finestra viene attivata: riempie il vettore con i nomi dei clienti che corrispondono.

Private Sub TbRicerca_Change()
  LbRisultati.Clear
  Elenco = ""

  Testo = TbRicerca.Text
  If (Len(Testo) > 1) Then
    'se ci sono almeno 2 cartteri riempie la lista
    For R = LBound(Clienti) To UBound(Clienti)
      If (InStr(1, Clienti(R), Testo, vbTextCompare) > 0) Then
        LbRisultati.AddItem Clienti(R)
      End If
    Next R
  Else
    ' con un solo carattere disattiva il bottone di conferma
    CbOK.Visible = False
  End If
End Sub

La risposta al cambiamento della stringa di ricerca: riempie la lista con i valori che contengono in testo cercato.

Private Sub TbRicerca_Change()
  LbRisultati.Clear
  Elenco = ""

  Testo = TbRicerca.Text
  If (Len(Testo) > 1) Then
    For R = LBound(Clienti) To UBound(Clienti)
      If (InStr(1, Clienti(R), Testo, vbTextCompare) > 0) Then
        LbRisultati.AddItem Clienti(R)
      End If
    Next R
  Else
    CbOK.Visible = False
  End If
End Sub

La risposta per il click sul bottone di conferma: riporta il codice nella cella e chiude la finestra.

Private Sub CbOK_Click()
pCellaDest.Value = Left(LbRisultati.BoundValue, instr(LbRisultati.BoundValue," "))
Unload Me
End Sub

Con il bottone annulla chiude solo la finestra senza modificare il valore.

Private Sub CbAnnulla_Click()
Unload Me
End Sub

Con il click del mouse su di un valore della lista attiva il bottone di conferma.

Private Sub LbRisultati_Click()
  If (Not IsNull(LbRisultati.BoundValue)) Then
    CbOK.Visible = True
  End If
End Sub

Con il doppio-click su di un elemento della lista, come per il tasto conferma, riporta il codice e chiude la finestra.

Private Sub LbRisultati_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  If (Not IsNull(LbRisultati.BoundValue)) Then
    pCellaDest.Value = Left(LbRisultati.BoundValue, instr(LbRisultati.BoundValue," ")-1)
    Unload Me
  End If
End Sub

Gli esempi contenuti nel sito sono per uso personale, non é consentito l'uso professionale, commerciale o la riproduzione senza autorizzazione.

Per dubbi o domande potete scriverci a domande@macrofacili.it, sulla nostra pagina FB MacroFacili.it o sul gruppo FB Excel, macro e formule.