12.2Приложение 2
[Form_ГЛАВНАЯ ФОРМА (Code)]
Option Compare Database
Private Sub Кнопка2_Click()
On Error GoTo Err_Кнопка2_Click
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = "Сотрудники"
DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_Кнопка2_Click:
Exit Sub
Err_Кнопка2_Click:
MsgBox Err.Description
Resume Exit_Кнопка2_Click
End Sub
Private Sub Кнопка3_Click()
On Error GoTo Err_Кнопка3_Click
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = ChrW(1040) & ChrW(1088) & ChrW(1093) & ChrW(1080) & ChrW(1074) & ChrW(32) & ChrW(1057) & ChrW(1086) & ChrW(1090) & ChrW(1088) & ChrW(1091) & ChrW(1076) & ChrW(1085) & ChrW(1080) & ChrW(1082) & ChrW(1080)
DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_Кнопка3_Click:
Exit Sub
Err_Кнопка3_Click:
MsgBox Err.Description
Resume Exit_Кнопка3_Click
End Sub
Private Sub Кнопка5_Click()
On Error GoTo Err_Кнопка5_Click
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = ChrW(1042) & ChrW(1080) & ChrW(1076) & ChrW(32) & ChrW(1086) & ChrW(1073) & ChrW(1098) & ChrW(1077) & ChrW(1082) & ChrW(1090) & ChrW(1072)
DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_Кнопка5_Click:
Exit Sub
Err_Кнопка5_Click:
MsgBox Err.Description
Resume Exit_Кнопка5_Click
End Sub
Private Sub Кнопка6_Click()
On Error GoTo Err_Кнопка6_Click
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = ChrW(1054) & ChrW(1073) & ChrW(1086) & ChrW(1088) & ChrW(1091) & ChrW(1076) & ChrW(1086) & ChrW(1074) & ChrW(1072) & ChrW(1085) & ChrW(1080) & ChrW(1077)
DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_Кнопка6_Click:
Exit Sub
Err_Кнопка6_Click:
MsgBox Err.Description
Resume Exit_Кнопка6_Click
End Sub
Private Sub Кнопка7_Click()
On Error GoTo Err_Кнопка7_Click
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = ChrW(1053) & ChrW(1072) & ChrW(1080) & ChrW(1084) & ChrW(1077) & ChrW(1085) & ChrW(1086) & ChrW(1074) & ChrW(1072) & ChrW(1085) & ChrW(1080) & ChrW(1077) & ChrW(32) & ChrW(1086) & ChrW(1073) & ChrW(1086) & ChrW(1088) & ChrW(1091) & ChrW(1076) & ChrW(1086) & ChrW(1074) & ChrW(1072) & ChrW(1085) & ChrW(1080) & ChrW(1103)
DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_Кнопка7_Click:
Exit Sub
Err_Кнопка7_Click:
MsgBox Err.Description
Resume Exit_Кнопка7_Click
End Sub
Private Sub Кнопка8_Click()
On Error GoTo Err_Кнопка8_Click
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = ChrW(1054) & ChrW(1073) & ChrW(1098) & ChrW(1077) & ChrW(1082) & ChrW(1090) & ChrW(1099)
DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_Кнопка8_Click:
Exit Sub
Err_Кнопка8_Click:
MsgBox Err.Description
Resume Exit_Кнопка8_Click
End Sub
Private Sub Кнопка9_Click()
On Error GoTo Err_Кнопка9_Click
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = ChrW(1089) & ChrW(1087) & ChrW(1080) & ChrW(1089) & ChrW(1072) & ChrW(1085) & ChrW(1080) & ChrW(1077) & ChrW(32) & ChrW(1086) & ChrW(1073) & ChrW(1086) & ChrW(1088) & ChrW(1091) & ChrW(1076) & ChrW(1086) & ChrW(1074) & ChrW(1072) & ChrW(1085) & ChrW(1080) & ChrW(1103)
DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_Кнопка9_Click:
Exit Sub
Err_Кнопка9_Click:
MsgBox Err.Description
Resume Exit_Кнопка9_Click
End Sub
Private Sub Кнопка10_Click()
On Error GoTo Err_Кнопка10_Click
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = ChrW(1057) & ChrW(1087) & ChrW(1080) & ChrW(1089) & ChrW(1072) & ChrW(1085) & ChrW(1085) & ChrW(1086) & ChrW(1077) & ChrW(1054) & ChrW(1073) & ChrW(1086) & ChrW(1088) & ChrW(1091) & ChrW(1076) & ChrW(1086) & ChrW(1074) & ChrW(1072) & ChrW(1085) & ChrW(1080) & ChrW(1077)
DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_Кнопка10_Click:
Exit Sub
Err_Кнопка10_Click:
MsgBox Err.Description
Resume Exit_Кнопка10_Click
End Sub
Private Sub Кнопка11_Click()
On Error GoTo Err_Кнопка11_Click
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = ChrW(1054) & ChrW(1090) & ChrW(1087) & ChrW(1088) & ChrW(1072) & ChrW(1074) & ChrW(1082) & ChrW(1072) & ChrW(32) & ChrW(1074) & ChrW(32) & ChrW(1057) & ChrW(1077) & ChrW(1088) & ChrW(1074) & ChrW(1080) & ChrW(1089)
DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_Кнопка11_Click:
Exit Sub
Err_Кнопка11_Click:
MsgBox Err.Description
Resume Exit_Кнопка11_Click
End Sub
Private Sub Кнопка12_Click()
On Error GoTo Err_Кнопка12_Click
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = ChrW(1047) & ChrW(1072) & ChrW(1082) & ChrW(1088) & ChrW(1077) & ChrW(1087) & ChrW(1083) & ChrW(1077) & ChrW(1085) & ChrW(1080) & ChrW(1077) & ChrW(32) & ChrW(1086) & ChrW(1073) & ChrW(1086) & ChrW(1088) & ChrW(1091) & ChrW(1076) & ChrW(1086) & ChrW(1074) & ChrW(1072) & ChrW(1085) & ChrW(1080) & ChrW(1103)
DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_Кнопка12_Click:
Exit Sub
Err_Кнопка12_Click:
MsgBox Err.Description
Resume Exit_Кнопка12_Click
End Sub
Private Sub Кнопка13_Click()
On Error GoTo Err_Кнопка13_Click
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = ChrW(1054) & ChrW(1090) & ChrW(1087) & ChrW(1088) & ChrW(1072) & ChrW(1074) & ChrW(1082) & ChrW(1072) & ChrW(32) & ChrW(1074) & ChrW(32) & ChrW(1072) & ChrW(1088) & ChrW(1093) & ChrW(1080) & ChrW(1074)
DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_Кнопка13_Click:
Exit Sub
Err_Кнопка13_Click:
MsgBox Err.Description
Resume Exit_Кнопка13_Click
End Sub
Private Sub Кнопка14_Click()
On Error GoTo Err_Кнопка14_Click
Screen.PreviousControl.SetFocus
DoCmd.FindNext
Exit_Кнопка14_Click:
Exit Sub
Err_Кнопка14_Click:
MsgBox Err.Description
Resume Exit_Кнопка14_Click
End Sub
Private Sub Кнопка16_Click()
On Error GoTo Err_Кнопка16_Click
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = "ОборудованиеНаОбъектах"
DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_Кнопка16_Click:
Exit Sub
Err_Кнопка16_Click:
MsgBox Err.Description
Resume Exit_Кнопка16_Click
End Sub
[Form_Наименование оборудования (Code)]
Option Compare Database
Private Sub Кнопка4_Click()
On Error GoTo Err_Кнопка4_Click
DoCmd.GoToRecord , , acNewRec
Exit_Кнопка4_Click:
Exit Sub
Err_Кнопка4_Click:
MsgBox Err.Description
Resume Exit_Кнопка4_Click
End Sub
[Form_Закрепление оборудования (Code)]
Option Compare Database
Private Sub Поле12_AfterUpdate()
DoCmd.GoToRecord acDataForm
End Sub
Private Sub Кнопка14_Click()
On Error GoTo Err_Кнопка14_Click
Screen.PreviousControl.SetFocus
DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70
Exit_Кнопка14_Click:
Exit Sub
Err_Кнопка14_Click:
MsgBox Err.Description
Resume Exit_Кнопка14_Click
End Sub
Private Sub Кнопка28_Click()
With CurrentDb.OpenRecordset("ЖурналОборудования")
.AddNew
.Fields("ID_оборудования") = [подчиненная форма Оборудование]![ID]
.Fields("ID_ОБЪЕКТА") = [подчиненная форма Объекты]![ID]
.Update
.Close
End With
With CurrentDb.OpenRecordset("Оборудование")
On Error Resume Next
.MoveLast
.MoveFirst
Do Until .EOF
If [подчиненная форма Оборудование]![ID] = ![ID] Then
.Edit
.Fields("Объект") = True
.Update
GoTo l1
End If
.MoveNext
Loop
l1: .Close
End With
DoCmd.Close acForm, "Закрепление оборудования"
DoCmd.OpenForm "Закрепление оборудования"
End Sub
[Form_Отправка в Сервис (Code)]
Option Compare Database
Private Sub flag_AfterUpdate()
With CurrentDb.OpenRecordset("ОборудованиеВСервисе")
On Error Resume Next
.MoveLast
.MoveFirst
Do Until .EOF
If ![ID_оборудования] = ID And ![Признак] = "s" Then
If d_pol < d_ot Then
MsgBox "Дата получениния из Сервиса не может быть раньше даты отправки в Сервис!!!", vbCritical
.Close
Exit Sub
End If
.Edit
.Fields("Дата снятия") = d_pol
.Fields("Признак") = "o"
.Update
flag = False
line.Visible = False
d_ot.Visible = False
serv.Visible = False
tab_num.Visible = False
d_pol.Visible = False
Надпись22.Visible = False
Надпись24.Visible = False
Надпись27.Visible = False
Надпись29.Visible = False
Надпись32.Visible = False
date_rem.SetFocus
flag.Visible = False
MsgBox "Теперь вы можете отправить в сервис!!!", vbInformation
GoTo l1
End If
.MoveNext
Loop
l1: .Close
End With
End Sub
Private Sub Кнопка19_Click()
If k = Null Then
MsgBox "Введите дату отправки в сервис!!!", vbCritical
Exit Sub
End If
If tabel = "" Then
MsgBox "Введите табельный номер сотрудника!!!", vbCritical
Exit Sub
End If
With CurrentDb.OpenRecordset("ОборудованиеВСервисе")
On Error Resume Next
.MoveLast
.MoveFirst
Do Until .EOF
If ![ID_оборудования] = ID And ![Признак] = "s" Then
d_ot = ![Дата]
serv = ![вид сервиса]
tab_num = ![табельный номер]
MsgBox "Оборудование уже находится в ремонте!Необходимо снять его с предыдущего ремонта для назначения нового", vbCritical
line.Visible = True
d_ot.Visible = True
serv.Visible = True
tab_num.Visible = True
d_pol.Visible = True
Надпись22.Visible = True
Надпись24.Visible = True
Надпись27.Visible = True
Надпись29.Visible = True
Надпись32.Visible = True
flag.Visible = True
.Close
Exit Sub
End If
.MoveNext
Loop
.Close
End With
DoCmd.OpenQuery "Service"
End Sub
[Form_ОборудованиеНаОбъектах (Code)]
Option Compare Database
Private Sub Кнопка13_Click()
On Error GoTo Err_Кнопка13_Click
Screen.PreviousControl.SetFocus
DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70
Exit_Кнопка13_Click:
Exit Sub
Err_Кнопка13_Click:
MsgBox Err.Description
Resume Exit_Кнопка13_Click
End Sub
Private Sub Кнопка14_Click()
On Error GoTo Err_Кнопка14_Click
Screen.PreviousControl.SetFocus
DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70
Exit_Кнопка14_Click:
Exit Sub
Err_Кнопка14_Click:
MsgBox Err.Description
Resume Exit_Кнопка14_Click
End Sub
Private Sub Кнопка18_Click()
On Error GoTo Err_Кнопка18_Click
Dim stDocName As String
stDocName = "Установленное оборудование"
DoCmd.OpenReport stDocName, acPreview
Exit_Кнопка18_Click:
Exit Sub
Err_Кнопка18_Click:
MsgBox Err.Description
Resume Exit_Кнопка18_Click
End Sub
[Form_СписанноеОборудование (Code)]
Option Compare Database
Private Sub Кнопка18_Click()
On Error GoTo Err_Кнопка18_Click
DoCmd.GoToRecord , , acPrevious
Exit_Кнопка18_Click:
Exit Sub
Err_Кнопка18_Click:
MsgBox Err.Description
Resume Exit_Кнопка18_Click
End Sub
Private Sub Кнопка19_Click()
On Error GoTo Err_Кнопка19_Click
DoCmd.GoToRecord , , acNext
Exit_Кнопка19_Click:
Exit Sub
Err_Кнопка19_Click:
MsgBox Err.Description
Resume Exit_Кнопка19_Click
End Sub
Private Sub Кнопка20_Click()
On Error GoTo Err_Кнопка20_Click
Screen.PreviousControl.SetFocus
DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70
Exit_Кнопка20_Click:
Exit Sub
Err_Кнопка20_Click:
MsgBox Err.Description
Resume Exit_Кнопка20_Click
End Sub
[Form_Объекты (Code)]
Option Compare Database
Private Sub type_ob_AfterUpdate()
With CurrentDb.OpenRecordset("Объекты")
On Error Resume Next
.MoveLast
.MoveFirst
Do Until .EOF
If ![Адрес объекта] = adress And ![Наименование типа объекта] <> type_ob Then
MsgBox "Для этого адреса назначен другой объект !!!!", vbCritical
DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70
.Close
Exit Sub
End If
.MoveNext
Loop
.Close
End With
End Sub
Private Sub Кнопка7_Click()
On Error GoTo Err_Кнопка7_Click
DoCmd.GoToRecord , , acNewRec
Exit_Кнопка7_Click:
Exit Sub
Err_Кнопка7_Click:
MsgBox Err.Description
Resume Exit_Кнопка7_Click
End Sub
Private Sub Кнопка9_Click()
On Error GoTo Err_Кнопка9_Click
DoCmd.GoToRecord , , acPrevious
Exit_Кнопка9_Click:
Exit Sub
Err_Кнопка9_Click:
MsgBox Err.Description
Resume Exit_Кнопка9_Click
End Sub
Private Sub Кнопка10_Click()
On Error GoTo Err_Кнопка10_Click
DoCmd.GoToRecord , , acNext
Exit_Кнопка10_Click:
Exit Sub
Err_Кнопка10_Click:
MsgBox Err.Description
Resume Exit_Кнопка10_Click
End Sub
[Form_Вид объекта (Code)]
Option Compare Database
Private Sub Кнопка7_Click()
On Error GoTo Err_Кнопка7_Click
DoCmd.GoToRecord , , acNewRec
Exit_Кнопка7_Click:
Exit Sub
Err_Кнопка7_Click:
MsgBox Err.Description
Resume Exit_Кнопка7_Click
End Sub
Private Sub Кнопка9_Click()
On Error GoTo Err_Кнопка9_Click
DoCmd.GoToRecord , , acPrevious
Exit_Кнопка9_Click:
Exit Sub
Err_Кнопка9_Click:
MsgBox Err.Description
Resume Exit_Кнопка9_Click
End Sub
Private Sub Кнопка10_Click()
On Error GoTo Err_Кнопка10_Click
DoCmd.GoToRecord , , acNext
Exit_Кнопка10_Click:
Exit Sub
Err_Кнопка10_Click:
MsgBox Err.Description
Resume Exit_Кнопка10_Click
End Sub
[Form_Сотрудники (Code)]
Option Compare Database
Private Sub Кнопка13_Click()
On Error GoTo Err_Кнопка13_Click
DoCmd.GoToRecord , , acFirst
Exit_Кнопка13_Click:
Exit Sub
Err_Кнопка13_Click:
MsgBox Err.Description
Resume Exit_Кнопка13_Click
End Sub
Private Sub Кнопка14_Click()
On Error GoTo Err_Кнопка14_Click
DoCmd.GoToRecord , , acNext
Exit_Кнопка14_Click:
Exit Sub
Err_Кнопка14_Click:
MsgBox Err.Description
Resume Exit_Кнопка14_Click
End Sub
Private Sub Кнопка15_Click()
On Error GoTo Err_Кнопка15_Click
DoCmd.GoToRecord , , acPrevious
Exit_Кнопка15_Click:
Exit Sub
Err_Кнопка15_Click:
MsgBox Err.Description
Resume Exit_Кнопка15_Click
End Sub
Private Sub Кнопка16_Click()
On Error GoTo Err_Кнопка16_Click
DoCmd.GoToRecord , , acLast
Exit_Кнопка16_Click:
Exit Sub
Err_Кнопка16_Click:
MsgBox Err.Description
Resume Exit_Кнопка16_Click
End Sub
Private Sub Кнопка17_Click()
On Error GoTo Err_Кнопка17_Click
Screen.PreviousControl.SetFocus
DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70
Exit_Кнопка17_Click:
Exit Sub
Err_Кнопка17_Click:
MsgBox Err.Description
Resume Exit_Кнопка17_Click
End Sub
Private Sub Кнопка18_Click()
On Error GoTo Err_Кнопка18_Click
DoCmd.GoToRecord , , acNewRec
Exit_Кнопка18_Click:
Exit Sub
Err_Кнопка18_Click:
MsgBox Err.Description
Resume Exit_Кнопка18_Click
End Sub
Private Sub Кнопка19_Click()
On Error GoTo Err_Кнопка19_Click
DoCmd.Close
Exit_Кнопка19_Click:
Exit Sub
Err_Кнопка19_Click:
MsgBox Err.Description
Resume Exit_Кнопка19_Click
End Sub
|