VBA Tipp: Suchen (Filtern) im Endlosformular

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

  • Ich möchte ein Endlosformular nach einem oder mehreren Suchbegriffen, die ich in ein oder mehrere Suchfelder eingebe, filtern.
  • Der Filter soll nach jeder Eingabe eines Zeichens aktualisiert werden.

Lösung

Das geht mit folgender Private Sub-Prozedur, die im zugehörigen Formularmodul hinterlegt wird. In dieser Prozedur werden als Beispiel folgende Feldnamen verwendet:

  • Vier ungebundene Textfelder im Formularkopf mit Namen SNachname, SVorname, SStraße und STelefon, die als Suchfelder verwendet werden.
  • Die vier Formularfelder, nach denen gefiltert werden soll, heißen Nachname, Vorname, Straße und Telefonnummer.
Private Sub FilterSetzen()
 
   'Quelle: http://www.dbwiki.net/
 
   Dim ctl       As Control
   Dim strFilter As String
 
   'aktuelles Suchfeld in Variable einlesen
   Set ctl = Me.ActiveControl
 
   'Sonderbehandlung von Leerzeichen (Zeichen Nr. 32)
   If intkeyascii = 32 Then
      ctl = ctl & Chr(32)
      'Initialisierung der Variablen
      intkeyascii = 0
   End If
 
   'strFilter aus den Suchfeldern zusammenstellen (nach System von Reinhard Kraasch)
   'Filter bei Nachname, Vorname und Straße nach Like x*, bei Telefon Filter nach Like *x*
   'Wenn der Fokus auf dem Suchfeld ist, wird die Text-Eigenschaft abgefragt, ansonsten die Value-Eigenschaft.
   If ctl.Name = "SNachname" Then
      If Len(Me!SNachname.Text & vbNullString) > 0 Then strFilter = strFilter & " AND Nachname Like '" & Me!SNachname.Text & "*'"
   Else
      If Not IsNull(Me!SNachname.Value) Then strFilter = strFilter & " AND Nachname Like '" & Me!SNachname.Value & "*'"
   End If
 
   If ctl.Name = "SVorname" Then
      If Len(Me!SVorname.Text & vbNullString) > 0 Then strFilter = strFilter & " AND Vorname Like '" & Me!SVorname.Text & "*'"
   Else
      If Not IsNull(Me!SVorname.Value) Then strFilter = strFilter & " AND Vorname Like '" & Me!SVorname.Value & "*'"
   End If
 
   If ctl.Name = "SStraße" Then
      If Len(Me!SStraße.Text & vbNullString) > 0 Then strFilter = strFilter & " AND Straße Like '" & Me!SStraße.Text & "*'"
   Else
      If Not IsNull(Me!SStraße.Value) Then strFilter = strFilter & " AND Straße Like '" & Me!SStraße.Value & "*'"
   End If
 
   If ctl.Name = "STelefon" Then
      If Len(Me!STelefon.Text & vbNullString) > 0 Then strFilter = strFilter & " AND Telefonnummer Like '*" & Me!STelefon.Text & "*'"
   Else
      If Not IsNull(Me!STelefon.Value) Then strFilter = strFilter & " AND Telefonnummer Like '*" & Me!STelefon.Value & "*'"
   End If
 
   'Die ersten 5 Zeichen des strFilter abschneiden
   strFilter = Mid(strFilter, 6)
 
   'Filter setzen
   Me.Filter = strFilter
   Me.FilterOn = True
 
   'Bei leerem Suchfeld geht der Fokus verloren, daher wieder setzen
   ctl.SetFocus
 
   'Cursor ans Ende des eingegeben Textes setzen (nach DonKarl FAQ 4.24)
   ctl.SelStart = Len("" & ctl)
 
End Sub


Folgender Code wird jedem Suchfeld dem Ereignis Bei Änderung hinterlegt. Das Wort Suchfeld muß durch den entsprechenden Namen des Suchfeldes, z.B. SNachname, SVorname, SStraße oder STelefon ersetzt werden.

Private Sub Suchfeld_Change()
 
   Call FilterSetzen
 
End Sub


Folgender Code (für die Sonderbehandlung von Leerzeichen) wird jedem Suchfeld dem Ereignis Bei Taste hinterlegt. Das Wort Suchfeld muß durch den entsprechenden Namen des Suchfeldes, z.B. SNachname, SVorname, SStraße oder STelefon ersetzt werden.

Private Sub Suchfeld_KeyPress(KeyAscii As Integer)
 
   'die gedrückte Taste wird in der Private Variablen "intkeyascii" zwischengespeichert
   intkeyascii = KeyAscii
 
End Sub


Im Deklarationsbereich des Formulars wird diese Variable deklariert:

   Dim intkeyascii As Integer


Erweiterte Möglichkeit

Da der Benutzer in der Regel mehrere Zeichen schnell hintereinander (also einen kompletten Suchbegriff) ins Suchfeld eingibt, ist es sinnvoll, daß die Anwendung erst einmal einen kurzen Moment (z.B. 500 ms) wartet, bis der Benutzer mit dem Tippen fertig ist, bevor der Filtervorgang ausgelöst wird. Das erreicht man, indem man die Filterprozedur im Timer des Formulars ablaufen lässt.


Dazu wird folgender Code jedem Suchfeld dem Ereignis Bei Änderung hinterlegt. Das Wort Suchfeld muß durch den entsprechenden Namen des Suchfeldes, z.B. SNachname, SVorname, SStraße oder STelefon ersetzt werden.

Private Sub Suchfeld_Change()
 
   'Timer einschalten. 
   'Der Filter wird erst nach einer Wartezeit von 500 ms gesetzt.
   Me.TimerInterval = 500
 
End Sub


Im Formular-Ereignis Bei Zeitgeber wird folgender Code hinterlegt:

Private Sub Form_Timer()
 
   'Filter nach Timerzeit setzen
   Call FilterSetzen
 
   'Timer ausschalten
   Me.TimerInterval = 0
 
End Sub


Wiki hinweis.png

Hinweis:

Die Formulareigenschaft Anfügen zulassen muss auf Ja stehen, sonst wird, falls kein Datensatz gefunden wird,
  • in einer mdb-Datenbank der Fehler 2185 ausgelöst
  • in einer accdb-Datenbank der Filtervorgang abgebrochen


Wikilinks