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