Програма до форми «Пошук»
Option Compare Database
Private Sub cmdBegin_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
lblHelp.Caption = "Поле для вводу початку пошуку." _
& " Формат дати: дд.мм.рррр "
End Sub
Private Sub cmdEnd_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
lblHelp.Caption = "Поле для вводу дати кінця пошуку. Формат дати: дд.мм.рррр"
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
On Error GoTo ErrKeyPress
Dim strField As String, strCriteria As String
If KeyAscii = 13 Then 'была нажата клавиша Enter
Рахунки1.SetFocus
'Выполняем поиск по введенным датам
If grpDate = 1 Then
strField = "Дата_1"
Else
strField = "Дата_2"
End If
If Not IsNull(cmdBegin) Then
strCriteria = strField & ">=#" & _
Month(cmdBegin) & "/" & _
Day(cmdBegin) & "/" & _
Year(cmdBegin) & "#"
End If
If Not IsNull(cmdEnd) Then
37
IIf(strCriteria = "", "", " AND ")
strCriteria = strCriteria & _
strField & "<=#" & _
Month(cmdEnd) & "/" & _
Day(cmdEnd) & "/" & _
Year(cmdEnd) & "#"
End If
Рахунки1.Form.Filter = strCriteria
Рахунки1.Form.FilterOn = True
End If
Exit_Sub:
Exit Sub
ErrKeyPress:
If Err = 2110 Then
MsgBox "Неверный формат даты!", vbExclamation
Else
MsgBox "Ошибка №" & Err.Number & ": " & vbCrLf _
& Err.Description
GoTo Exit_Sub
End If
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyDelete And _
((Shift And acAltMask) = acAltMask) And _
((Shift And acShiftMask) = acShiftMask) Then
'Отменяем фильтр и
'чистим поля для ввода параметров поиска
'при нажатии DEL+ALT+SHIFT
cmdBegin = Null
cmdEnd = Null
Рахунки1.Form.Filter = ""
Рахунки1.Form.FilterOn = False
End If
End Sub
Private Sub grpDate_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
lblHelp.Caption = "Шукаємо по даті поступлення чи виписки"
End Sub
P
38
lblHelp.Caption = "Після вводу критеріїв пошуку потрібно натиснути Enter."
End Sub
Програма до форми «Хворі»
Option Compare Database
Private Sub Кнопка27_Click()
On Error GoTo Err_Кнопка27_Click
Screen.PreviousControl.SetFocus
DoCmd.FindNext
Exit_Кнопка27_Click:
Exit Sub
Err_Кнопка27_Click:
MsgBox Err.Description
Resume Exit_Кнопка27_Click
End Sub
Private Sub Кнопка28_Click()
Forms("Хворі").RecordSource = _
"SELECT * FROM Хворі WHERE Прізвище='" & txtFindLastName & "'"
End Sub