TopPicLogo TopPicText

Фильтрация подчиненной формы (По текстовому полю с оператором Like) DAO и ADO

Где:
      Me!txtSearch = Текстовое поле с искомым текстом
      Me!objSubForm.Form = ссылка на обьект - Подчиненная форма
"Вешаем" все это на событие AfterUpdate - поля с искомым текстом ...


Private Sub txtSearch_AfterUpdate()
Dim val As Variant
Dim strFilter As String
On Error GoTo txtSearch_AfterUpdateErr
    val = Me!txtSearch
    
    If IsNull(val) = False Then 'Образец для поиска задан

        Me!objSubForm.Form.FilterOn = False
        'Строим строку фильтра по оператору Like (совпадение с любой частью поля)

        strFilter = "[Имя поля по которому ищем] Like '*" & val & "*'"

        'Применяем фильтр
        Me!objSubForm.Form.Filter = strFilter
        Me!objSubForm.Form.FilterOn = True
        Me!objSubForm.SetFocus
    Else
        'Отмена рание наложенного фильтра 
        Me!objSubForm.Form.Filter = ""
        Me!objSubForm.Form.FilterOn = False
        Me!objSubForm.SetFocus
    End If


txtSearch_AfterUpdateBye:
    Exit Sub

txtSearch_AfterUpdateErr:
    MsgBox "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "in procedure txtSearch_AfterUpdate", vbCritical, "Error!"
    Resume txtSearch_AfterUpdateBye
End Sub



ADO

Private Sub txtSearch_AfterUpdate()
' Фильтрация подчиненной формы (По текстовому полю с оператором Like)
'--------------------------------------------------------------------------
Dim val As Variant, strFilter$
    
On Error GoTo txtSearch_AfterUpdate_Err
    
    val = Me!txtSearch
    
    With Me!objSubForm.Form
    
        If IsNull(val) = False Then 'Образец для поиска задан
            strFilter = "part_code Like '*" & val & "*' OR part_name Like '*" & val & "*'"
            .Recordset.Filter = adFilterNone
            .Recordset.Filter = strFilter
        Else
            .Recordset.Filter = adFilterNone
        End If
        Set .Recordset = .Recordset
    End With

txtSearch_AfterUpdate_Bye:
    Exit Sub

txtSearch_AfterUpdate_Err:
    MsgBox "Ошибка " & Err.Number & vbCrLf & Err.Description & vbCrLf & "в процедуре: txtSearch_AfterUpdate", vbCritical, "Error"
    Resume txtSearch_AfterUpdate_Bye
End Sub
Назад ToTop
L.E. 13.05.2017
Рейтинг@Mail.ru