Фильтрация формы по текстовому полю (Посимвольная) - По событию Change (+ Пример)
Конструируем фильтр на событии Change поля [SearchText]
Посимвольная фильтрация в форме
Private Sub SearchText_Change()
Dim iSelStart As Integer
On Error GoTo SearchText_Change_Err
If Right(Me!SearchText.Text, 1) = " " Then Exit Sub
Me.Painting = False
iSelStart = Me!SearchText.SelStart
Me!cmdFilterClear.SetFocus
FormRefilter
Me!SearchText.SetFocus
Me!SearchText.SelStart = iSelStart
SearchText_Change_End:
On Error Resume Next
Me.Painting = True
Err.Clear
Exit Sub
SearchText_Change_Err:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub SearchText_Change.", _
vbCritical, "Произошла ошибка!"
Err.Clear
Resume SearchText_Change_End
End Sub
Private Sub FormRefilter()
Dim s$
On Error GoTo FormRefilter_Err
Me!SearchFilter = Null
If IsNull(Me!SearchText) = False Then
s = s & " AND SearchField Like '*" & Me!SearchText & "*'"
End If
If Me!SearchGroup.ListIndex > -1 Then
s = s & " AND GdGroup_SID = " & Me!SearchGroup.Column(0)
End If
If s <> "" Then
s = Mid(s, 6)
Me.Form.Filter = s
Me.Form.FilterOn = True
Me.AllowAdditions = (Me.Recordset.RecordCount = 0)
Me!SearchFilter = s
Else
Me.Form.Filter = ""
Me.Form.FilterOn = False
Me.AllowAdditions = False
End If
FormRefilter_End:
On Error Resume Next
Err.Clear
Exit Sub
FormRefilter_Err:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub FormRefilter.", _
vbCritical, "Произошла ошибка!"
Err.Clear
Resume FormRefilter_End
End Sub
Универсальный вариант:
Private Sub П1_Change()
FormRefilter Me!П1
End Sub
Private Sub П2_Change()
FormRefilter Me!П2
End Sub
Private Sub П3_Change()
FormRefilter Me!П3
End Sub
Private Sub FormRefilter(idField As Control)
Dim s$, iSelStart&
On Error GoTo FormRefilter_Err
If Right(idField.Text, 1) = " " Then Exit Sub
Me.Painting = False
iSelStart = idField.SelStart
Me!КнСбросФилтр.SetFocus
If IsNull(Me!П1) = False Then
s = s & " AND Фамилия Like '*" & Me!П1 & "*'"
End If
If IsNull(Me!П2) = False Then
s = s & " AND Имя Like '*" & Me!П2 & "*'"
End If
If IsNull(Me!П3) = False Then
s = s & " AND Отчество Like '*" & Me!П3 & "*'"
End If
If s <> "" Then
s = Mid(s, 6)
Me!Subfrm.Form.Filter = s
Me!Subfrm.Form.FilterOn = True
Me!Subfrm.Form.AllowAdditions = (Me!Subfrm.Form.Recordset.RecordCount = 0)
Else
Me!Subfrm.Form.Filter = ""
Me!Subfrm.Form.FilterOn = False
Me!Subfrm.Form.AllowAdditions = False
End If
idField.SetFocus
idField.SelStart = iSelStart
FormRefilter_End:
On Error Resume Next
Me.Painting = True
Err.Clear
Exit Sub
FormRefilter_Err:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub FormRefilter.", _
vbCritical, "Произошла ошибка!"
Err.Clear
Resume FormRefilter_End
End Sub
MSA-2003 ( 178 kB) Пример
|