VBA, MS Access MS Access в примерах

Фильтрация формы по текстовому полю (Посимвольная) - По событию Change (+ Пример)

Конструируем фильтр на событии Change поля [SearchText]
Посимвольная фильтрация в форме

Private Sub SearchText_Change()
'Фильтр на событии Change поля [SearchText]
'es - 07.12.2019
'----------------------------------------------------------------
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, "Произошла ошибка!"
    'Debug.Print "SearchText_Change_Line: " & Erl & "."
    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
    
    'SearchGroup
    If Me!SearchGroup.ListIndex > -1 Then
        s = s & " AND GdGroup_SID = " & Me!SearchGroup.Column(0)
    End If
    
    
'Дата c - по
'    If IsNull(Me!дата1) = False Or IsNull(Me!дата2) = False Then
'        s = s & " AND DataField Between " & _
'                Format$(Nz(Me!дата1, 0), "\#mm\/dd\/yyyy\#") & _
'                " And " & Format$(Nz(Me!дата2, 999999), "\#mm\/dd\/yyyy\#")  ' На Null = #11/25/4637#
'    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
        'Debug.Print s
        'Debug.Print (Me.Recordset.RecordCount = 0)
    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, "Произошла ошибка!"
    'Debug.Print "FormRefilter_Line: " & Erl & "."
    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, "Произошла ошибка!"
    'Debug.Print "FormRefilter_Line: " & Erl & "."
    Err.Clear
    Resume FormRefilter_End

End Sub

Picture




Скачать

MSA-2003 ( 178 kB) Пример


Назад ToTop
L.E. 23.12.2022
Рейтинг@Mail.ru