|
|
Фильтрация Ленточной формы по различным полям и по диапазону дат (+ Пример)
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$
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\#")
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
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)
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 & " - " & Error(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
Private Sub txtДатаПо_Change()
DateFieldsUPD
End Sub
Private Sub txtДатаС_Change()
DateFieldsUPD
End Sub
Private Sub DateFieldsUPD()
Dim iStart%, iLen%
Dim objCtrl As Control
Set objCtrl = Me.ActiveControl
iStart = objCtrl.SelStart
iLen = objCtrl.SelLength
If Len(objCtrl.Text) = 10 And IsDate(objCtrl.Text) Then
objCtrl.Value = CDate(objCtrl.Text)
Else
If Len(objCtrl.Text) = 0 Then
objCtrl.Value = Null
Else
Exit Sub
End If
End If
FormRefilter
objCtrl.SetFocus
objCtrl.SelStart = iStart
objCtrl.SelLength = iLen
Set objCtrl = Nothing
End Sub
MSA-2007 и выше ( 159 kB) Пример
|
|