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 Formularmodul hinterlegt wird.

  • Benötigt werden dazu (in diesem Beispiel) 4 ungebundene Textfelder im Formularkopf, die als Suchfelder verwendet werden.
  • Die Namen dieser Suchfelder heißen (in diesem Beispiel) SNachname, SVorname, SStraße und STelefon.
  • Die Namen der Formularfelder, nach denen gefiltert werden soll, heißen Nachname, Vorname, Straße und Telefonnummer.
Private Sub FilterSetzen()
 
 'Quelle: www.dbwiki.net oder www.dbwiki.de
 
 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)
 
 'Speicher freigeben
 Set ctl = Nothing
 
End Sub


Folgender Code wird jedem Suchfeld beim Ereignis Bei Änderung hinterlegt. Das Wort Suchfeld muß durch die entsprechenden Begriffe SNachname, SVorname, SStraße oder STelefon ersetzt werden.
Private Sub Suchfeld_Change()
 
 Call FilterSetzen
 
End Sub


Folgender Code wird jedem Suchfeld für das Ereignis Bei Taste hinterlegt. Das Wort Suchfeld muß durch die entsprechenden Begriffe SNachname, SVorname, SStraße oder STelefon ersetzt werden.
Private Sub Suchfeld_KeyPress(KeyAscii As Integer)
 
' die gedrückte Taste wird in der Private Variablen zwischengespeichert
 intkeyascii = KeyAscii
 
End Sub


Im Deklarationsbereich des Formulars wird die Variable deklariert:
Dim intkeyascii As Integer


Erweiterte Möglichkeit

Da der Benutzer in der Regel mehrere Zeichen auf einmal (also einen kompletten Suchbegriff) ins Suchfeld eingibt, ist es sinnvoll, daß Access erst einmal wartet, bis der Benutzer mit dem Tippen fertig ist, bevor der Filtervorgang angestoßen wird. Das erreicht man, indem man die Filterprozedur im Timer des Formulars ablaufen lässt.


Dazu wird folgender Code jedem Suchfeld beim Ereignis Bei Änderung hinterlegt. Das Wort Suchfeld muß durch die entsprechenden Begriffe 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 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 ein Fehler ausgelöst, wenn kein Datensatz gefunden wird.



Der Code wurde in Access 2003 erstellt.