Dynamisch filteren in access Uitgebreid

Status
Niet open voor verdere reacties.
Let op bij het gebruik van IsNumeric om het veldtype te bepalen!
Voorbeeld:
waarde 01234 geeft bij functie IsNumeric, Waar, maar het veldtype is tekst.
 
Laatst bewerkt:
hmm zou hierdoor het "at random sorteren misschien plaatsvinden?
zou het ook mogelijk zijn hier het veldtype te bepalen wat hij later in de code dan weer checked?
of is dat te simpel gedacht?

Private Sub txtFilter1_Change()
sNaam = Screen.ActiveControl.Name
sTag = Me(sNaam).Tag
sWaarde = Me(sNaam).Text
CheckFilter sNaam, sWaarde
Me(sNaam) = sWaarde
Me(sNaam).SelStart = Me(sNaam).SelLength
End Sub
 
Ik zie inderdaad in het andere formulier wat meer filtertjes. Maar je hebt daar inderdaad een probleem met de Klanten naam, en dat is ook wel logisch: je keuzelijst Klanten heeft als waarde namelijk niet de naam, maar het KlantID. Niet alleen is dat numeriek (wat we ondertussen opgelost hebben), maar een KlantID is natuurlijk niet hetzelfde als een Klantnaam.... Doorgaans valt daar ook weinig op te filteren; elk KlantID is uniek, en derhalve is het resultaat van een filter op KlantID één record. Of je moet met Like werken, maar dan krijg je naar mijn idee een onzinnige selectie terug. Stel dat je filtert op het getal 2. Dan wil je, neem ik aan, KlantID 2 zien, en niet de klantID's 2, 12, 22, 24 102 129 etc. Alle klanten die "Jansen" heten kan ik mij wel voorstellen, maar alle klanten waar een2 in de klantID zit? Kortom: als je op KlantNaam wilt filteren, zul je de bron van je rapport moeten aanpassen. Niet meer een tabel, maar een query waarbij je de tabel Klanten toevoegt, en uit die tabel het veld Klantnaam. Dat extra veld zet je dan uiteraard ook in het formulier, zodat je bij elke klant het KlantID ziet, en de KlantNaam. Filteren doe je dan niet meer op de keuzelijst, maar op het extra veld.
 
hmm dat klinkt logisch er vallen wat kwartjes :-)
ik ga weer even stoeien.

Werknummer is alleen wel tekst wat nu dan gezien wordt als een nummeriek veld?
of kan ik dat omzeilen?
 
Werknummer is alleen wel tekst wat nu dan gezien wordt als een nummeriek veld?
of kan ik dat omzeilen?
Klik om te vergroten...
Zoals ik al eerder aangaf, de functie IsNumeric is onbetrouwbaar om te bepalen of een veldtype numeriek of tekst is!
 
Hij filtert nog steeds at random lijkt wel... :S

http://www.mijnbestand.nl/Bestand-BATQTI8JKI6A.rar

Zou hierdoor het "at random" filteren misschien plaatsvinden?
zou het ook mogelijk zijn het veldtype vast te zetten wat hij later in de code dan weer checked? alleen DossierID is echt nummeriek. (Werknummer kan ook teskt bevatten.)

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

@ Harry
sorry ik ben (nog) niet handig met VBA.
 
De code die je hebt gebruikt stamt uit een oudere versie van het formulier.... Ik was er inmiddels zelf ook achter gekomen dat hij niet helemaal jofel werkte, en heb inmiddels een verbeterde versie gemaakt. Jammer genoeg betekent dat uiteraard dat de code weer een stuk ingewikkelder is geworden. Om even kort uit te leggen wat het probleem was: de functie keek eerst naar de ingevulde filtervelden met een loop, en de te filteren waarden werden dan opgeslagen in een matrix, die qua grootte afhankelijk was van dat aantal ingevulde filters. Vervolgens werd op basis van de matrix een filter opgebouwd. Hierbij werd nogmaals door de filterobjecten gelust. Het probleem nu was, dat de nummering van de matrix met filterwaarden anders is dan de nummering die gehanteerd werd bij het samenstellen van het filter. Dat is geen probleem als je alle velden filtert, want dan zijn de aantallen gelijk. Maar dat is natuurlijk niet altijd het geval. Resultaat is nu: als je in txtFilter6 een tekst intypt, dan kan die tekst in het filter worden gekoppeld aan txtFilter3. Dus je typt bij Plaats de letters GR in om Groningen te filteren, maar het filter wordt dan gemaakt op het veld Klantnaam. Je filtert dan dus niet op Plaatsen met GR, maar op Klanten met GR. En dat is natuurlijk niet de bedoeling.

Toen ik daar achter kwam, heb ik de procedure daarop aangepast. Hij ziet er nu zo uit:

Code: 
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 tmpMatrix
Dim tmp
Dim rst As Recordset
Dim iFltr As Integer, iLst As Integer

'-----------------------------------------------------------------------------------------------------------
'Eerst de grootte van de matrix bepalen....
'Dat doen we door alle filters door te lopen, en de inhoud in een matrix te zetten.
'We lopen door de controls heen op basis van het ControlType.
'-----------------------------------------------------------------------------------------------------------
x = 0

iFltr = 0
iLst = 0

For Each ctl In Controls
    With ctl
        Select Case .ControlType
            Case acTextBox
                If LCase(Left(.Name, 9)) = "txtFilter" Then
                    .SetFocus
                    iFltr = iFltr + 1
                    On Error Resume Next
                    If Not .Text = "" Then
                        x = x + 1
                        If x = 1 Then
                            ReDim sTekst(x)
                        Else
                            ReDim Preserve sTekst(x)
                        End If
                        '-----------------------------------------------------------------------------------
                        'De matrix wordt gevuld met de Veldnaam, de Filternaam en het Filterveld.
                        'Deze worden met een scheidingsteken in één string gezet die later gesplitst wordt.
                        '-----------------------------------------------------------------------------------
                        sTekst(x) = .Tag & "|" & .Text & "|" & .Name
                    End If
                End If
            Case acListBox
                '-------------------------------------------------------------------------------------------
                'Een listbox kan meerdere items bevatten die geselecteerd worden.
                'Die moeten allemaal apart worden uitgelezen.
                '-------------------------------------------------------------------------------------------
                If LCase(Left(.Name, 9)) = "lstFilter" Then
                    sKeuze = ""
                    .SetFocus
                    iFltr = iFltr + 1
                    iLst = iLst + 1
                    On Error Resume Next
                    If Me("lstFilter" & iLst).ItemsSelected.Count >= 1 Then
                        x = x + 1
                        If x = 1 Then
                            ReDim sTekst(x)
                        Else
                            ReDim Preserve sTekst(x)
                        End If
                        For Each itm In Me("lstFilter" & iLst).ItemsSelected
                            sKeuze = sKeuze & Me("lstFilter" & iLst).ItemData(itm) & "\"
                        Next itm
                        Do While Right(sKeuze, 1) = "\"
                            sKeuze = Left(sKeuze, Len(sKeuze) - 1)
                        Loop
                        '-----------------------------------------------------------------------------------
                        'Ook hier wordt een samengestelde string gemaakt van de filterwaarden.
                        '-----------------------------------------------------------------------------------
                        sTekst(x) = .Tag & "|" & sKeuze & "|" & .Name
                    End If
                End If
            Case acComboBox
                If LCase(Left(.Name, 9)) = "cboFilter" Then
                    .SetFocus
                    iFltr = iFltr + 1
                    On Error Resume Next
                    If Not .Value = "" Then
                        x = x + 1
                        If x = 1 Then
                            ReDim sTekst(x)
                        Else
                            ReDim Preserve sTekst(x)
                        End If
                        sTekst(x) = .Tag & "|" & .Text & "|" & .Name
                    End If
                End If
        End Select
    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.
'===========================================================================================================

'-----------------------------------------------------------------------------------------------------------
'Dan de variabelen vullen met gegevens
'We doen dat door een extra matrix te maken op basis van het filter
'-----------------------------------------------------------------------------------------------------------
ReDim sFilters(x, 3)
For i = LBound(sFilters) To UBound(sFilters)
    tmpMatrix = Split(sTekst(i), "|")
    For x = LBound(tmpMatrix) To UBound(tmpMatrix)
        sFilters(i, x + 1) = tmpMatrix(x)
    Next x
Next i
i = 0
x = 0
'===========================================================================================================

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

sFilter = ""
For i = LBound(sFilters) To UBound(sFilters)
    If LBound(sFilters) = UBound(sFilters) Then
        If InStr(sFilters(i, 2), "\") > 0 Then
            tmpMatrix = Split(sFilters(i, 2), "\")
            For x = LBound(tmpMatrix) To UBound(tmpMatrix)
                '-------------------------------------------------------------------------------------------
                'Eerst controleren of er getallen in het spel zijn, of tekst.
                '-------------------------------------------------------------------------------------------
                If IsNumeric(tmpMatrix(x)) Then
                    sFilter = sFilter & "[" & sFilters(i, 1) & "] = " & tmpMatrix(x)
                Else
                    sFilter = sFilter & "[" & sFilters(i, 1) & "] Like ""*" & tmpMatrix(x) & "*"""
                End If
                If x < UBound(tmpMatrix) Then sFilter = sFilter & " OR "
            Next x
        Else
            sFilter = sFilter & "[" & sFilters(i, 1) & "] Like ""*" & sFilters(i, 2) & "*"""
        End If
    Else
        '---------------------------------------------------------------------------------------------------
        'Vervolgens controleren of de listbox meerdere items bevat, die gesplitst moeten worden.
        'Die worden dan allemaal apart worden uitgelezen en in het filter gezet.
        '---------------------------------------------------------------------------------------------------
        If InStr(sFilters(i, 2), "\") > 0 Then
            tmpMatrix = Split(sFilters(i, 2), "\")
            For x = LBound(tmpMatrix) To UBound(tmpMatrix)
                '-------------------------------------------------------------------------------------------
                'Uiteraard ook hier weer controleren of er getallen in het spel zijn, of tekst.
                '-------------------------------------------------------------------------------------------
                If IsNumeric(tmpMatrix(x)) Then
                    sFilter = sFilter & "[" & sFilters(i, 1) & "] = " & tmpMatrix(x)
                Else
                    sFilter = sFilter & "[" & sFilters(i, 1) & "] Like ""*" & tmpMatrix(x) & "*"""
                End If
                If x < UBound(tmpMatrix) Then sFilter = sFilter & " OR "
            Next x
        Else
            If IsNumeric(sFilters(i, 2)) Then
                sFilter = sFilter & "[" & sFilters(i, 1) & "] = " & sFilters(i, 2)
            Else
                sFilter = sFilter & "[" & sFilters(i, 1) & "] Like ""*" & sFilters(i, 2) & "*"""
            End If
            If i < UBound(sFilters) Then
                sFilter = sFilter & sAndOr
            End If
        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
'===========================================================================================================

'-----------------------------------------------------------------------------------------------------------
'En als laatste functie om de verticale scrollbar aan- of uit te zetten.
'-----------------------------------------------------------------------------------------------------------
CheckScrollbar
'===========================================================================================================

Exit Function

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

End Function

Overigens vind ik de numerieke/tekst discussie wel grappig; een 'tekst' als 01234 is natuurlijk een getal, of je er nu wel of niet een voorloopnul voorzet. Dat je een getal in een tekstveld opslaat, en dus eigenlijk op tekst moet filteren en niet op een getal is dan een heel andere vraag... Bij getallen wil je, zoals ik eerder al zei, niet willekeurig filteren of een cijfer voorkomt in een waarde. Alle klanten met een 5 in het ID? Niet echt zinvol. Bij getallen wil je misschien wel op reeksen filteren: alle klanten met een omzet tussen €10.000 en €50.000 bijvoorbeeld.
Eigenlijk zou je, als je het helemaal correct wilt doen, eerst moeten achterhalen wat het veldtype is van het veld waarop je filtert. Die eigenschap zou moeten bepalen of je op tekst filtert, of op getallen of datums. Niet de inhoud van het veld. Daar zijn ook wel weer functies voor te bedenken, maar die maken het verhaal uiteraard nog weer een stukkie complexer. Niet onmogelijk overigens, want de veldnaam wordt meegenomen in de filterfunctie, dus met een kleine zijsprong (extra functie) kun je het veldtype wel opzoeken.
Maar probeer dus getallen op te slaan in een getalveld, tenzij er een legitieme reden is om er een tekstveld van te maken, zoals bij telefoonnummers etc. Een veld met Werknummers valt daar m.i. dan weer niet onder. Kortom: behandel een getal als een getal, dan kun je er ook mee werken als een getal. Getallen sorteren en filteren als tekst is een beetje zinloos. Maar dat is mijn opvatting...
 
Ja het vervelende blijft dat in een werknummer ook Bijvoorbeeld AMS1234 voor kan komen. Waardoor je met een getal veld waarschijnlijk tegen problemen aanloopt?
Misschien dat in die "algemene kop" het veldtype ingesteld kan? waar hij dan weer naar kijkt bij het filteren.
Bij deze nieuwe code loopt hij bij mij vast op sKeuze :(.

Het voorbeeld van Harry begin ik langzaam ook te snappen. :-)
en lijkt het perfect te doen! :D

Hebben jullie misschien nog tips om VBA beter onder de knie te krijgen?
Ik werk nu veelal met Macro's om formulieren en tijdelijke variabele enz in te stellen.
Maar volgens mij is dat ook handiger om uiteindelijk met code te doen.

Ontzettend bedankt voor de hulp! :D
 
Ik probeer nu naar het voorbeeld bestnadje van Harry de kies dossier knop aan te passen zodat Acces het DossierID tijdelijk opslaat zodat ik deze waarde in een ander formulier automatisch kan laten invoeren.

Zo kan formulier 1 een knop bevatten naar het dossier opzoekformulier. Hier druk ik vervolgens op Kies dossier waarna het DossierID opgeslagen wordt en dit formulier sluit.
In Formulier 1 probeer ik vervolgens deze waarde automatisch in te laten vullen in een ander veld.

Ik dacht een module te maken waarin ik het volgende stukje code heb gezet...
Code: 
Option Compare Database
Option Explicit

Function tmpDossierIDOpslaan() As Integer
'geheugen reserveren voor tmpDossierID
Dim tmpDossierID As Integer
'Variabele declareren
tmpDossierID = DossierID
End Function


Function tmpDossierIDLaden() As Integer
Me.DossierID = tmpDossierID
End Function

Vervolgens dacht ik op formulier 1 te verwijzen naar tmpDossierIDLaden.
en bij de kies dossier knop naar tmpDossierIDOpslaan.
Blijkbaar te simpel gedacht of deugt me eerste code voor geen kant.
 
Je moet het huidige DossierID opslaan in een publieke (globale) variabele in een algemene module.
Die waarde leg je vast bij b.v. de 'on current' gebeurtenis van een formulier of op het moment dat je op een knop klikt in dat formulier.
Daarna kun je deze publieke variabele o.a. weer oproepen via een functie, zoals dat ook al in jouw code zit.
Met de naamgeving zoals ik die zou gebruiken wordt het dan:
In de algemene module:
Code: 
Option Compare Database
Option Explicit

Public plngDossierGeselecteerd As Long

Function fDossierGeselecteerd() As Long
	fDossierGeselecteerd=plngDossierGeselecteerd
End Fuction

Op het formulier, bij een zelf te kiezen gebeurtenis:
Code: 
plngDossierGeselecteerd=me!DossierID

Opmerking:
Een publieke/globale variabele verliest zijn waarde als er een fout optreedt in het programma indien die fout niet wordt 'afgevangen' door een foutprocedure
 
sorry deze code snap ik nog niet helemaal.

In het voorbeeld bestandje heb ik de volgende regel verwijderd:
Code: 
DoCmd.OpenForm "frmDossiersEnkel", , , "dossier_ID=" & Me!Dossier_ID

Ik neem aan dat ik hiervoor in de plaats de tweede code zet
Code: 
plngDossierGeselecteerd=me!DossierID

Daarnaast maak ik een module aan zoals in de eerste code
Code: 
Option Compare Database
Option Explicit

Public plngDossierGeselecteerd As Long

Function fDossierGeselecteerd() As Long
	fDossierGeselecteerd=plngDossierGeselecteerd
End Function


Vervolgens doe ik in het formulier waar ik de waarde wil oproepen
Code: 
Private Sub Form_Load()
Me.DossierID = fDossierGeselecteerd
End Sub

Maar dat klopt blijkbaar nog niet helemaal... :(
 
Waarschijnlijk een verwarring met de naam. Ik heb de naam van het ID veld overgenomen uit jouw laatste vraag (DossierID), maar zie dat je in de db een andere naam gebruikt (Dossier_ID)
Dan wordt
plngDossierGeselecteerd=me!DossierID
dus
plngDossierGeselecteerd=me!Dossier_ID
 
hmm vreemd ik had eerder ook al naar de veldnamen gekeken en ze wel veranderd...
Toen deed hij het niet, maar nu doet hij het wel :D.
Ik ga denk ik meer van dit soort filter zoek schermen bouwen en op deze manier laten invoeren! :D
Erg leuk en ontzettend bedankt!!
 
Ik ga denk ik meer van dit soort filter zoek schermen bouwen
Klik om te vergroten...
Dan zou je de code algemener kunnen maken, door ze, na wat aanpassingen, in een algemene module te zetten. Die code kan dan van uit ieder zoekformulier worden opgeroepen.
 
Thanks

OctaFish zei:
Je hebt een formulier <Filteren> in je db, die het inderdaad niet doet. Maar die had ik binnen 12 seconden weer aan de praat: de velden die in de tabel zaten heb je een andere naam gegeven op de tekstvakken. Op zich mag dat wel, maar je filtert op de Tabelvelden, niet op de Formuliervelden. Dus door de <Extra Info> in de zoekvelden te koppen aan de tabelvelden, deed het filter het gelijk weer. Maar je laatste opmerking slaat vermoedelijk op een ander formulier?
Klik om te vergroten...

Ik heb een hele namiddag gezocht naar de oplossing. Hier ligt zo in 12 seconden. Inderdaad, Extra Info was de oplossing.:d
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan