kruimeltjes
Gebruiker
- Lid geworden
- 30 sep 2009
- Berichten
- 222
Kan iemand mij uitleggen wat deze functie precies doet? Of misschien beter gezegd wat er wordt omschreven, wat dit doet weet snap ik.
Groetjes,
Simone
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 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)
i = i + 1
If Not sTekst((i)) = "" Then
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 FunctionGroetjes,
Simone
