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

Фильтрация подчиненной формы по различным полям и по диапазону дат

Основной код из главной формы :


Private Sub cbxСотрудник_AfterUpdate() 'Событие : "После Обновления"
    FormRefilter
End Sub

Private Sub cmdRemoveFilter_Click()
'Зачистка фильтра:
    Me!txtДатаС = Null
    Me!txtДатаПо = Null
    Me!cbxДолжность = Null
    Me!cbxСотрудник = Null
    Me!txtПримечание = Null
    FormRefilter
End Sub

Private Sub FormRefilter(Optional sDSCRText$ = "")
'Аргумент: sDSCRText - для пердачи текста в процедуру для поля "Примечание"
'Построройка фильтра по полям и фильтрация (если задано):
Dim sFilter$, sTemp$

'Даты c - по (Поле:"ДатаНач"):
    If IsNull(Me!txtДатаС) = False Or IsNull(Me!txtДатаПо) = False Then
        sFilter = sFilter & _
        " AND ДатаНач Between " & Format$(Nz(Me!txtДатаС, 0), "\#mm\/dd\/yyyy\#") & _
        " And " & Format$(Nz(Me!txtДатаПо, 999999), "\#mm\/dd\/yyyy\#")
        ' 999999 = 4637-й год! :)
    End If
    
'Должность (Поле:"ДолжностьКод"):
    If Me!cbxДолжность.ListIndex > -1 Then 'Значение выбрано
        sFilter = sFilter & " AND ДолжностьКод = " & Me!cbxДолжность
    End If
    
'Сотрудник (Поле:"СотрудникКод"):
    If Me!cbxСотрудник.ListIndex > -1 Then 'Значение выбрано
        sFilter = sFilter & " AND СотрудникКод = " & Me!cbxСотрудник
    End If
    
'Примечание (Text! - Поле:"Примечание")
    If Not sDSCRText = "" Then 'В передан текст для поиска
        sFilter = sFilter & " AND Примечание Like '*" & sDSCRText & "*'"
    Else
        If IsNull(Me!txtПримечание) = False Then 'Поле не пустое
            'меняем пробелы на звёздочки (не обязательно)
            sTemp = Replace(Me!txtПримечание, " ", "*")
            sFilter = sFilter & " AND Примечание Like '*" & sTemp & "*'"
        End If
    End If
    
    If sFilter <> "" Then 'Фильтр задан
        sFilter = Mid(sFilter, 6) 'Обрезаем первый " AND "
        Me!objПодчиненная.Form.Filter = sFilter
        Me!objПодчиненная.Form.FilterOn = True
    Else 'Отмена фильтра
        Me!objПодчиненная.Form.Filter = ""
        Me!objПодчиненная.Form.FilterOn = False
    End If
End Sub

Private Sub txtПримечание_Change()
'Фильтрация "на лету" (по мере ввода данных в поле)
    FormRefilter Me!txtПримечание.Text
End Sub



Код из подчинённой формы (опционально):

Private Sub Form_Error(DataErr As Integer, Response As Integer)
    If DataErr = 3314 Then 'Не заполнено обязательное поле
        MsgBox "Поле является обязательным для заполнения, " & vbCrLf & _
            "Вы не можете оставить его пустым!", vbExclamation, "Заполните поле"
        Response = acDataErrContinue 'Заглушка на стандартное сообщение
    'Else
        'Debug.Print DataErr
    End If
End Sub

Picture




Скачать

MSA-2007 и выше ( 68 kB) Пример


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