Basenburgen
Gebruiker
- Lid geworden
- 25 feb 2011
- Berichten
- 59
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.
(Vervolgens wil ik het DossierID opslaan wat ik verder wil gebruiken. Maar daar moet ik wel uitkomen)
Helaas krijg ik het bestandje niet geupload in de bijlage (ongeveer 40 kb) Dus ik zal het nog iets uitgebreider beschrijven.
Ik heb een TBL_Klanten en een TBL_Dossiers.
TBL_Dossiers bestaat uit; DossierID(autnummering), Dossier (Tekst bijvoorbeeld; A-1234), Klant (gekoppeld met TBL_Klanten), Werk, Werknummer, Plaats en Actief (Ja/Nee om inactieve dossiers weg te filteren).
Vervolgens heb ik FRM_Dossiers aangemaakt met de velden uit TBL_Dossiers.
Deze staan in tabelindeling zodat ik in de kop bovenin de labels heb dan een regel met niet-afhankelijke tekstinvoervelden met in de details de tekstvelden die uit TBL_dossiers gehaald worden waarin gesorteerd moet worden. Rechts van iedere regel zit vervolgens een knop die de DossierID moet opslaan voor verdergebruik.
Ik heb de VBA code (waar ik erg slecht in ben helaas) uit het (laatste) voorbeeld bestandje van dit topic http://www.helpmij.nl/forum/showthread.php/552084-Dynamisch-filteren-in-Access aangepast.
Maar ik loop tegen flink wat problemen aan...
weet iemand raad?
alvast bedankt
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.
(Vervolgens wil ik het DossierID opslaan wat ik verder wil gebruiken. Maar daar moet ik wel uitkomen)
Helaas krijg ik het bestandje niet geupload in de bijlage (ongeveer 40 kb) Dus ik zal het nog iets uitgebreider beschrijven.
Ik heb een TBL_Klanten en een TBL_Dossiers.
TBL_Dossiers bestaat uit; DossierID(autnummering), Dossier (Tekst bijvoorbeeld; A-1234), Klant (gekoppeld met TBL_Klanten), Werk, Werknummer, Plaats en Actief (Ja/Nee om inactieve dossiers weg te filteren).
Vervolgens heb ik FRM_Dossiers aangemaakt met de velden uit TBL_Dossiers.
Deze staan in tabelindeling zodat ik in de kop bovenin de labels heb dan een regel met niet-afhankelijke tekstinvoervelden met in de details de tekstvelden die uit TBL_dossiers gehaald worden waarin gesorteerd moet worden. Rechts van iedere regel zit vervolgens een knop die de DossierID moet opslaan voor verdergebruik.
Ik heb de VBA code (waar ik erg slecht in ben helaas) uit het (laatste) voorbeeld bestandje van dit topic http://www.helpmij.nl/forum/showthread.php/552084-Dynamisch-filteren-in-Access aangepast.
Maar ik loop tegen flink wat problemen aan...
Code:
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 Subweet iemand raad?
alvast bedankt
Wat is het probleem met uploaden? Normaal gesproken mag 40 kb geen probleem zijn; probeer het bestand anders eerst te zippen, dan moet het vast wel lukken.
)
