Yaslaw.Info

This page is read only. You can view the source, but not change it. Ask your administrator if you think this is wrong.
====== [VBA][Access] Flexibler Filter zusammenstellen ======
Immer wieder kommt die Frage auf, wie man einen flexiblen Filterstring zusammensetzen kann. Es ist eigentlich ganz einfach.

Ich habe ein Beispiel angehängt: {{ :vba:tutorials:filterexample.zip |}}

Zuerst habe ich mal ein Formular mit den verscheidenen Felder.
{{ :vba:tutorials:filterexampleform.png?nolink |}}

Und hinter dem Button ist der folgende Code. Der Rest ist im Code selber beschrieben
<code vb>Option Compare Database
Option Explicit

'Konzept:
'1)     Ein Array für die Teilfilters definieren
'2a)    Jedes Feld prüfen, ob ein Filter angegeben wurde.
'2b)    Wenn ja, den Teilfilterstring erstellen und dem Array hinzufügen
'3)     Alle Teilfilter mittels join() zu einem einzigen Filterstring zusammenführen

'/**
' * Erstellt den Filterstring
' */
Private Sub cmdCreateFilter_Click()
    Dim filters() As String     'Die Teilfilter
    Dim id As Variant           'ID as der Listbox
    Dim ids() As String         'Alle IDS aus der Listbox
    Dim filterString As String  'fertiger Filterterstring
    
    'Zahlenfeld             [FELD] = 999
    If Not IsNull(Me.txtNumber) Then pushArray filters, "[Number Field 1] = " & Me.txtNumber
    'Textfeld               [FELD] = 'text'
    If Not IsNull(Me.txtText) Then pushArray filters, "[Text Field 1] = '" & Me.txtText & "'"
    'ID aus Combox          [FELD] = 999
    If Not IsNull(Me.cbxList) Then pushArray filters, "[Number Field 2] = " & Me.cbxList
    'Mehrere IDs aus Liste  [FELD] IN (item1, item2, ..itemX)
    If Me.lstMultiList.ItemsSelected.count > 0 Then
        'Alle ausgewählten IDS auslesen und in einem Array zusammenfassen
        For Each id In Me.lstMultiList.ItemsSelected
            pushArray ids, id
        Next id
        'Den Filterstring zusammensetzen
        pushArray filters, "[Number Field 3] IN (" & Join(ids, ", ") & ")"
    End If
    'Datumfeld              [FELD] = #MM/DD/YYYY#
    If Not IsNull(Me.dtpDate) Then pushArray filters, "[Date Field] = " & format(Me.dtpDate, "\#MM\/DD\/YYYY\#")
    
    'Alle Filters mit AND verknüpfen
    filterString = Join(filters, " AND ")
    'Für die Ausgabe erstelle ich den Filterstring mit Zeilenumbrüche.
    Me.txtOutFilter.Value = Join(filters, " " & vbCrLf & "AND ")
End Sub

'/**
' * Erweitert einen Array um eins und fügt einen Inhalt hinzu
' * NewIndex = pushArray(Array, Item)
' * @param  Array       Array, der erweitert werden soll
' * @param  Variant     Neuer Wert
' * @return Long        Index des neuen Wertes
' */
Private Function pushArray(ByRef ioArray As Variant, ByVal iItem As Variant) As Long
    On Error Resume Next:   pushArray = UBound(ioArray) + 1:   On Error GoTo 0
    ReDim Preserve ioArray(pushArray):     ioArray(pushArray) = iItem
End Function</code>
Yaslaw.Info

User Tools

Site Tools

Page Tools
