Dynamische filter met 3 velden

[rebirth]

Ik had hier op het forum een mooi en handig voorbeeldje gevonden van Octafish, waarbij er in een formulier een dynamische filter staat.
Ik had deze wat overgenomen, in de hoop van deze aan het werk te krijgen in mijn formulier. Ik heb hem voor een stukje aan het werk gekregen, maar helaas niet zoals ik het had willen hebben. Ik had een filter willen toepassen op naam, adres en plaats. Ik had het vakje met de keuze tussen and en or weggenomen, omdat ik graag had gehad dat hij de bestaande selectie verfijnde, wanneer je een tweede filterveld invulde. Dus ging ik er vanuit dat het zowiezo altijd een AND is.

Echter lukt zelfs een eerste stap al niet. Ik kan wel perfect filteren op de naam, maar wanneer ik het filterveld van de naam leeg laat en bvb iets invul bij het filterveld van het adres of de plaats, dan krijg ik niet alle gegevens die ik zou moeten krijgen. Iemand een idee waar de oorzaak zou kunnen zitten?

Dit gebruik ik momenteel:

Option Compare Database
Option Explicit
Option Base 1
Dim rst As Recordset
Dim sNaam As String, sTag As String, tmp As String, sWaarde As String
Dim x As Integer, i As Integer

Private Sub txtFilter1_Change()
    sNaam = Screen.ActiveControl.Name
    sTag = Screen.ActiveControl.Tag
    sWaarde = Me.txtFilter1.Text
    CheckFilter sNaam, sWaarde
    Me.txtFilter1 = sWaarde
    Me.txtFilter1.SelStart = Me.txtFilter1.SelLength
End Sub

Private Function CheckFilter(Optional Zoekveld As String, Optional Waarde As String)
Dim sFilter As String
Dim sFilters() As String, sTekst() As String
Dim ctl As Control
Dim sAndOr As String
Dim rst As Recordset
Dim iFltr As Integer

'Eerst de grootte van de matrix bepalen....
x = 0
iFltr = 0
For Each ctl In Controls
    With ctl
        If LCase(Left(.Name, 9)) = "txtFilter" Then
            .SetFocus
            iFltr = iFltr + 1
            On Error Resume Next
            If Not .Text = "" Then
                x = x + 1
                ReDim Preserve sTekst(x)
                sTekst(x) = .Text
            End If
        End If
    End With
Next ctl

'Als de tekstfilters leeg zijn, dan filter leegmaken en stoppen....
If x = 0 Then GoTo LeegFilter
'...... anders doorgaan, en matrix herdefiniëren.
ReDim sFilters(x, 3)

'Dan de variabelen vullen met gegevens
i = 0
x = 0
For Each ctl In Controls
    With ctl
        If LCase(Left(.Name, 9)) = "txtFilter" Then
            .SetFocus
''            MsgBox Asc(.Text)
            If Not sTekst((i + 1)) = "" Then
                i = i + 1
                sFilters(i, 1) = .Tag
                sFilters(i, 2) = sTekst(i)
                sFilters(i, 3) = .Name
                x = x + 1
            End If
        End If
    End With
Next ctl

'Dan op basis van de variabelen het filter opbouwen
'Select Case Me.fraOptie.Value
'    Case 1
        sAndOr = " AND "
'    Case 2
'        sAndOr = " OR "
'End Select

For i = LBound(sFilters) To UBound(sFilters)
    If LBound(sFilters) = UBound(sFilters) Then
        sFilter = "[" & sFilters(i, 1) & "] Like ""*" & sFilters(i, 2) & "*"""
    Else
        sFilter = sFilter & "[" & sFilters(i, 1) & "] Like ""*" & sFilters(i, 2) & "*"""
        If i < UBound(sFilters) Then
            sFilter = sFilter & sAndOr
        End If
    End If
Next i

'Filter vervolgens op formulier toepassen.
Me.Filter = sFilter
Me.FilterOn = True

If Not Zoekveld = "" Then
    Me(Zoekveld).SetFocus
End If

Set rst = Me.RecordsetClone
With rst
    .Bookmark = Me.Bookmark
    Me!lblNavigate.Caption = "Record " & _
        .AbsolutePosition + 1 _
        & " of " & .RecordCount
    .MoveLast
    .MovePrevious
    If .RecordCount < 26 Then
        Me.ScrollBars = 0
    Else
        Me.ScrollBars = 2
    End If
End With

Exit Function

LeegFilter:
    Me.Filter = ""
    Me.FilterOn = False
    On Error Resume Next
    Me(Zoekveld).SetFocus

End Function

Private Sub txtFilter2_Change()
    sNaam = Screen.ActiveControl.Name
    sTag = Screen.ActiveControl.Tag
    sWaarde = Me.txtFilter2.Text
    CheckFilter sNaam, sWaarde
    Me.txtFilter2 = sWaarde
    Me.txtFilter2.SelStart = Me.txtFilter2.SelLength
End Sub

Private Sub txtFilter3_Change()
    sNaam = Screen.ActiveControl.Name
    sTag = Screen.ActiveControl.Tag
    sWaarde = Me.txtFilter3.Text
    CheckFilter sNaam, sWaarde
    Me.txtFilter3 = sWaarde
    Me.txtFilter3.SelStart = Me.txtFilter3.SelLength
End Sub

 

[OctaFish]

We hebben meer aan de database; de functie werkt zoals je hebt gezien prima in mijn voorbeeldje. Ergo: in jouw db zit iets niet helemaal goed. Wellicht dat je de Tags niet hebt ingevuld. Overigens kun je, als je maar 3 filtervelden wilt, dat ook makkelijk in de code van de tekstvakken zelf zetten. Eén voorbeeldje voor het veld txtPlaats ziet er dan zo uit:

Private Sub txtPlaats_Change()
Dim sFilter As String, sWaarde As String

    sWaarde = Me.txtPlaats.Text
    If sWaarde & "" <> "" Then sFilter = "[Plaats] Like '*" & sWaarde & "*'"
    If Me.txtNaam.Value & "" <> "" Then
        If sFilter & "" <> "" Then sFilter = sFilter & " AND "
        sFilter = sFilter & "[Naam] Like '*" & Me.txtNaam.Value & "*'"
    End If
    If Me.txtAdres.Value & "" <> "" Then
        If sFilter & "" <> "" Then sFilter = sFilter & " AND "
        sFilter = sFilter & "[Adres] Like '*" & Me.txtAdres.Value & "*'"
    End If
    If sFilter & "" <> "" Then
        Me.Filter = sFilter
        Me.FilterOn = True
    Else
        Me.Filter = sFilter
        Me.FilterOn = True
    End If
    Me.txtPlaats.Text = sWaarde
    Me.txtPlaats.SelStart = Me.txtPlaats.SelLength

End Sub

Je kunt de code bijna letterlijk bij de 2 andere tekstvakken gebruiken, alleen de eigenschappen Text en Value aanpassen. De Change propertie moet namelijk Text uitlezen en niet Value.

 

[rebirth]

Hallo Octafish,

Waarschijnlijk heb ik inderdaad wel iets verkeerd gedaan, ik moet eerlijk bekennen dat ik het een beetje moeilijk had om de volledige werking van de code te begrijpen
Ik heb alvast even de db bijgevoegd, maar ik ga zo meteen ook even experimenteren met de code die je hierboven plaatste, misschien lukt het me zo al
In elk geval, alvast bedankt voor je hulp.


Bekijk bijlage klantbeheer.zip

 

[OctaFish]

Het filter dat je gebruikte was nog een oudere versie, die niet helemaal correct werkte als een veld leeg was. Het filter werd dan gemaakt op het verkeerde veld. Voobeeldje: je vulde alleen een letter in txtFilter3 in (Plaats) en dan filterde hij op Naam. Dat werkt natuurlijk niet. Ik heb de db aangepast.

 

[rebirth]

Super! Hartelijk dank OctaFish. Waaraan lag het feit dat hij filterde op Naam terwijl dit op Plaats moest? Waar heb ik dan iets over het hoofd gezien voor die?

 

[OctaFish]

Oei, technische vraag
De functie maakt gebruik van 2 lussen, waarvan de eerste alleen gebruikt wordt om de dimensies van de filtermatrix vast te stellen. Dat was nodig omdat je een multidimensionale matrix niet 'live' kunt aanpassen, wat bij een enkelvoudige matrix wel kan. (voordat mensen gaan reageren: dat is niet helemaal waar wat ik zeg, maar dat is in het kader van de vraag niet relevant) Daarbij werd de zoektekst ook alvast in een matrix vastgelegd. En daar ging het dus fout, want op het moment dat je alleen het derde veld invult, werd er in sTekst(x) ook maar één waarde opgeslagen. Die staat dan op de eerste positie in de matrix. In de tweede lus, die het filter opbouwt, werden alle velden weer stuk voor stuk uitgelezen. En hierbij werd de matrix sTekst gebruikt om het filter te vullen. Maar als daar maar één waarde in staat die uit het derde veld is gehaald, en je leest vervolgens alle filtervelden opnieuw uit, en je begint daarbij weer bij 1, dan krijgt het eerste tekstfilter de waarde uit de matrix sTekst. De vervolglussen genereerden vervolgens een foutmelding die werd genegeerd, want in de tweede lus zou de tweede waarde uit sTekst gebruikt moeten worden. Maar die bestaat dan dus helemaal niet.
Kortom: de fout bestond eruit dat de waarden in sTekst niet overeenkwamen qua positie met de tekstvelden waarop je filtert. En dat is nu dus aangepast.

 

[rebirth]

aha, is me toch iets duidelijker nu Alleen zo kan ik bijleren. Nogmaals dank voor de hulp en oplossing OctaFish!

 

[bva]

Dynamische filter met meer dan 3 velden

Hallo OctaFish,

Ik heb voor mijn database ook het dynamische filter en bestandje gebruikt.
Het werkt echt super (dank daar voor)
Ik zou wat meer filters erbij willen hebben.
En die dan ook gelust zijn met de huidige.
Is het dan een kwestie van de tekst tussen de End if kopiëren en er onder plaatsen?

Ik hoop dat ik het goed omschreven heb en anders zal ik mijn bestandje uploaden.

mvg. Ben

 

[OctaFish]

Maak even een eigen vraag aan, het wordt niet zo op prijs gesteld als je in een afgeronde topic van iemand anders een nieuwe vraag stelt. Wordt de beheerde heel droevig van . En zet er gelijk je bestandje bij, dat helpt altijd.