MyTetra Share
Делитесь знаниями!
Фильтрация подчиненной формы по текстовому полю с оператором Like (DAO и ADO)
19.07.2018
07:00
Раздел: VBA - Access - msa.polarcom.ru - 06 Формы Подчиненные


Фильтрация подчиненной формы по текстовому полю с оператором 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

Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования