Dynamisch filteren in Access

Status
Niet open voor verdere reacties.
B

Bentm

Gebruiker
Lid geworden
9 jun 2010
Berichten
24
Kan iemand mij helpen het voor elkaar te krijgen om dynamische te kunnen filteren in Access. Ik zal even proberen uit te leggen wat ik bedoel:

Bij het gewone selectiefilter kan ik niet zoeken op een gedeelte van een veld. Bij zoeken via 'ctrl f' moet ik nog instellingen wijzigen om te zoeken op een specifiek veld. Ik zou gewoon een tekstvak willen bovenaan mijn formulier die ongeacht wat ik type filtert op deze letters.

Ik heb al een voorbeeld gezien welke mij ontzettend aansprak. Maar ben nog niet goed genoeg thuis in VBA om het helemaal om te zetten naar mijn situatie. Die post kwam van Octofish.

Weet iemand een makkelijke manier om mij te helpen? Alvast bedankt!!

Grt
 
Een voorbeeldje is waarschijnlijk makkelijker...
Als je op één veld wilt filteren, kun je dat doen met een tekstvak. Je maakt dan een VBA procedure op het <Bij wijzigen> event.
In bijgaand voorbeeld heb ik een tekstvak txtFilter gemaakt, dat filtert op het formulierveld [Instelling].
Code: 
Private Sub txtFilter_Change()
Dim sFilter
    sFilter = "[Instelling] Like ""*" & Me.txtFilter.Text & "*"""
    Me.Filter = sFilter
    Me.FilterOn = True
    Me.txtFilter.SelStart = Me.txtFilter.SelLength
End Sub
Met wat aanpassingen wel te gebruiken, lijkt me...
 
Thanx man! Werkt perfect!

Nog een kleine vraag.... Heb In een database namen die ik heb opgedeeld in de velden voornaam, tussenvoegsel en achternaam. Het volstaat in zekere zin natuurlijk om alleen op achternaam te filteren, maar stel dat ik het filter wil leggen over drie velden, kan ik de code dan uitbreiden door meerdere veldnamen te gebruiken in de code?!

Het is geen must, maar zou wel handig zijn!

Cheers
 
Ben er al mee bezig! Want dat is uiteraard de logische vervolgvraag.... Overigens is daar dus de crux een stuk moeilijker, omdat je dan een check moet hebben op de overige tekstvelden, en daar een aangepaste filterstring voor moet maken. Ik heb al wel een oplossing voor je waarbij je meerdere aparte tekstvelden kunt gebruiken. Die ziet er zo uit:

Code: 
Private Sub Filteren(Tekst As String, Veld As String, Zoekveld As String)
    sFilter = "[" & Veld & "] Like ""*" & Tekst & "*"""
    Me.Filter = sFilter
    Me.FilterOn = True
    Me(Zoekveld).SelStart = Me(Zoekveld).SelLength
End Sub
Dit is de Hoofdprocedure, die wordt aangeroepen vanuit de verschillende zoekvelden.
Code: 
Private Sub txtFilter1_Change()
''    Filteren (Me.txtFilter1.Text)
    sNaam = Screen.ActiveControl.Name
    sTag = Screen.ActiveControl.Tag
    Filteren Me.txtFilter1.Text, sTag, sNaam
End Sub
Filter1 is een tekstvak,
Code: 
Private Sub txtFilter2_Change()
Dim tmp As String
    sNaam = Screen.ActiveControl.Name
    sTag = Screen.ActiveControl.Tag
    Filteren Me.txtFilter2.Text, sTag, sNaam
End Sub
Filter2 is een ander tekstvak.
Hoe werkt dit nu? Je moet het filter duidelijk maken op welk veld er moet worden gefilterd. Dat doe je door de naam van het tekstveld over te nemen in de <Extra Info> eigenschap van het Zoekveld.
In mijn voorbeeld heb ik twee zoekvelden, txtFilter1 en txtFilter2. In txtFilter1 gebruik ik het veld [Instellingen] als filterveld, en txtFilter2 het veld [Toepassing]. Deze twee namen heb ik dus in de bijbehorende <Extra Info> getypt.
Verder is de hoofdcode nu dus apart gezet, en die wordt nu aangeroepen vanuit de tekstvakken, waarbij de Zoektekst, Naam van het tekstvak en Naam van het zoekvak worden meegegeven.
Ik zou zeggen: probeer 'm eens uit...
 
Ik heb in deze db een voorbeeldje gezet van de uitwerking van de eerder aangegeven opties. Nu is het ook mogelijk om tekst in één van de zoekvelden te typen, en te kiezen tussen Beide vakken gebruiken (EN) of beide vakken apart filteren (OF).
De code is een stuk simpeler dan het vorige voorbeeld, ook al omdat er hier geen keuzelijsten worden gebruikt. Overigens kan die optie nu simpel (wat is simpel... ;) ) worden toegevoegd.
 
Bij het filteren kan ik geen spaties typen... Dit lukt wel wanneer ik tussen twee letters een spatie type, echter niet aan het einde van een woord/tekst.... Weet jij hoe dit komt?

Grt
 
Ja, dat weet ik ondertussen ;) In deze versie lukt het wel...
 

Bijlagen

  • Filteren.zip
    87,4 KB · Weergaven: 346
Dynamisch filteren uitbreiden met meer velden

Hallo,

Ik wil graag een dynamisch filter om in meerdere velden tegelijk te zoeken.
Vaak is maar een deel van de gegevens voor handen en zoek ik een manier om toch met beperkte gegevens het juiste dossier te zoeken.
Ik heb een Tabel; TBL_Dossiers met de velden; DossierID, Dossier, Klant (gekoppeld aan TBL_Klanten), Werk, Werknummer, Plaats en Actief (Ja/Nee veld om inactieve dossiers te verbergen).
Vervolgens heb ik een formulier; FRM_Dossiers aangemaakt met TBL_Dossiers als uitgangspunt (Tabel indeling).
In de kop heb ik losse tekstinvoervelden gemaakt (die niet afhankelijk zijn) met de tabelveld namen met txtFilter ervoor. Oftewel txtFilterDossierID, txtFilterDossier enz.
Omdat er altijd wel iets bekend is wil ik standaard met alle velden tegelijk kunnen zoeken. (en daarna het DossierID van de gewenste record als TempVar opslaan om als invoer te gebruiken bij een ander formulier. Maar daar kom ik denk ik wel uit.)

Ik heb de VBA code (waar ik erg slecht in ben helaas) uit het (laatste) voorbeeld bestandje aangepast.

Maar ik loop tegen flink wat problemen aan...
Helaas laat het forum me om de een of andere reden geen bijlage meesturen (39kb).
In de volgende reactie zal ik de code zoals ik hem aangepast heb mee sturen.

[CPP]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 Form_Current()
CheckScrollbar
End Sub

Private Sub Form_Load()
CheckScrollbar
End Sub

Private Sub cmdFilterLeeg_Click()
Dim sControl As String
''MsgBox TypeName(sControl)

sControl = Screen.PreviousControl.Name
Me.txtFilterDossierID = ""
Me.txtFilterDossier = ""
Me.txtFilterKlant = ""
Me.txtFilterWerk = ""
Me.txtFilterWerknummer = ""
Me.txtFilterPlaats = ""
Me.Filter = ""
Me.FilterOn = False
Me.Requery
Me(sControl).SetFocus
CheckScrollbar
'' Form_Current

End Sub

Private Sub fraOptie_AfterUpdate()
CheckFilter
End Sub

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

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

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

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

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

Private Sub txtFilterPlaats_Change()
sNaam = Screen.ActiveControl.Name
sTag = Screen.ActiveControl.Tag
sWaarde = Me.txtFilterPlaats.Text
CheckFilter sNaam, sWaarde
Me.txtFilterPlaats = sWaarde
Me.txtFilterPlaats.SelStart = Me.txtFilterPlaats.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.... .......................... Vanaf hier is het abracadabra voor mij... :(
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.................. Dit stukje snap ik denk ik weer maar moet altijd AND zijn
Select Case Me.fraOptie.Value
Case 1
sAndOr = " AND "
Case 2
sAndOr = " OR "
End Select


'.......................................................................Ik denk dat ik hier iets moet aanpassen naar de txtFilters?
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

Function CheckScrollbar()

Set rst = Me.RecordsetClone
If Me.NewRecord Then
Me!lblNavigate.Caption = "New Record"
Else
With rst
.Bookmark = Me.Bookmark
Me!lblNavigate.Caption = "Record " & _
.AbsolutePosition _
& " of " & .RecordCount
End With
End If
On Error GoTo Stoppen
rst.MoveLast
rst.MovePrevious
If rst.RecordCount < 26 Then
Me.ScrollBars = 0
Else
Me.ScrollBars = 2
End If

Stoppen:

End Function


Private Sub LeegFilter_Click()

End Sub
[/CPP]

Heeft iemand tips waar te beginnen?

alvast bedankt
 
Graag even een eigen topic aanmaken. Je reageert nu in een topic van 2010, welke niet meer actueeel is. Daarbij is het niet toegestaan mee te liften in iemand zijn / haar topic.

slotje.gif
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan