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

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

Код из формы :

Private Sub cbxДолжность_AfterUpdate() 'Событие : "После Обновления"
    FormRefilter
End Sub

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()
'Построройка фильтра по полям и фильтрация (если не пустые):
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 Me.ActiveControl.Name = "txtПримечание" Then
        sTemp = Trim(Me!txtПримечание.Text)
    Else
        sTemp = Me!txtПримечание & ""
    End If
    If Len(sTemp) > 0 Then
        sTemp = Replace(sTemp, " ", "*")
        sFilter = sFilter & " AND Примечание Like '*" & sTemp & "*'"
    End If

    
    If sFilter <> "" Then 'Фильтр задан
        sFilter = Mid(sFilter, 6) 'Обрезаем первый " AND "
        Me.Filter = sFilter
        Me.FilterOn = True
        Me.txtFilter = sFilter
    Else 'Отмена фильтра
        Me.Filter = ""
        Me.FilterOn = False
        Me.txtFilter = Null
    End If
End Sub

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

Private Sub txtПримечание_AfterUpdate()
    FormRefilter
End Sub

Private Sub txtПримечание_Change()
Dim iSelStart%, iSelLen%
'Фильтрация "на лету" (по мере ввода данных в поле)
    If Right(Me!txtПримечание.Text, 1) = " " Then Exit Sub 'Заглушка на пробел в конце
    iSelStart = Me!txtПримечание.SelStart
    iSelLen = Me!txtПримечание.SelLength
    FormRefilter
    Me!txtПримечание.SetFocus
    Me!txtПримечание.SelStart = iSelStart
    Me!txtПримечание.SelLength = iSelLen
End Sub

Private Sub txtДатаПо_AfterUpdate(): FormRefilter: End Sub 'Событие : "После Обновления"
Private Sub txtДатаС_AfterUpdate(): FormRefilter: End Sub  'Событие : "После Обновления"




Picture




Скачать

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


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