Разработка АРМ сотрудника НОЧУ ДПО ЦПК Учебный центр ИнфоТеКС (1089304), страница 15
Текст из файла (страница 15)
WordTable.Rows.Add
WordObj.Activate
Set WordObj = Nothing
Exit_СоздСписУд_Click:
Exit Sub
Err_СоздСписУд_Click:
MsgBox Err.Description
Resume Exit_СоздСписУд_Click
EndSub
Листинг А.2 Модуль формы Предварительная запись
Private Sub СогласиеФлаг_AfterUpdate()
DoCmd.Save
End Sub
Private Sub Фильтр_AfterUpdate()
Me.Requery
EndSub
Листинг А.3 Модуль формы Создание группы
Private Sub Form_Open(Cancel As Integer)
Me![№Специальность] = [Forms]![ПредварительнаяЗапись]![Фильтр]
Me.Requery
End Sub
Private Sub №Специальность_AfterUpdate()
Me.Requery
End Sub
Private Sub ПометитьВсе_Click()
Dim strSQL As String
strSQL = "UPDATEПредварительнаяЗаписьSETПредварительнаяЗапись.ВключитьВгруппу = True " & _
"WHERE (((ПредварительнаяЗапись.№Специальность)=" & [Forms]![СозданиеГруппа]![№Специальность] & ") AND ((ПредварительнаяЗапись.Согласие)=true));"
DoCmd.SetWarningsFalse
'DoCmd.OpenQuery "СозданиеГруппаПометить"
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
Me!ПредварительнаяЗаписьСуб.Requery
End Sub
Private Sub УдалитьОтмеченное_Click()
Dim strSQL As String
strSQL = "UPDATEПредварительнаяЗаписьSETПредварительнаяЗапись.ВключитьВгруппу = false " & _
"WHERE (((ПредварительнаяЗапись.№Специальность)=" & [Forms]![СозданиеГруппа]![№Специальность] & ") AND ((ПредварительнаяЗапись.Согласие)=true));"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
Me!ПредварительнаяЗаписьСуб.Requery
End Sub
Private Sub СоздатьГруппу_Click()
DoCmd.SetWarnings False
DoCmd.OpenQuery "СозданиеГруппаСоздать"
DoCmd.OpenQuery "СозданиеГруппаСоздатьУчащийся"
DoCmd.OpenQuery "СозданиеГруппаОчистить"
DoCmd.SetWarnings True
Me!ПредварительнаяЗаписьСуб.Requery
EndSub
Листинг А.4 Модуль формы Анализ безубыточности
Private Sub ДатаДо_AfterUpdate()
Me!ПостЗатраты.Requery
Me!ПеремЗатраты.Requery
Me!Стоимость1.Requery
End Sub
Private Sub ДатаС_AfterUpdate()
Me!ПостЗатраты.Requery
Me!ПеремЗатраты.Requery
Me!Стоимость1.Requery
End Sub
Private Sub ФильтрСпец_AfterUpdate()
Me!ПостЗатраты.Requery
Me!ПеремЗатраты.Requery
Me!Стоимость1.Requery
EndSub
Листинг А.5 Модуль формы Архив
Private Sub Form_Activate()
Me.Requery
End Sub
Private Sub ДатаДо_AfterUpdate()
Me.Requery
End Sub
Private Sub ДатаС_AfterUpdate()
Me.Requery
End Sub
Private Sub ОткрГруппа_Click()
If IsNull(Me![№Группа]) Then Exit Sub
DoCmd.OpenForm "УчебныйПроцесс", , , , , , Me![№Группа]
End Sub
Private Sub ОтменаФильтра_Click()
On Error GoTo Err_ОтменаФильтра_Click
Me!ФильтрСпец = Null
Me!ДатаС = Null
Me!ДатаДо = Null
Me!ФИО = Null
Me.Requery
Exit_ОтменаФильтра_Click:
Exit Sub
Err_ОтменаФильтра_Click:
MsgBox Err.Description
Resume Exit_ОтменаФильтра_Click
End Sub
Private Sub ФильтрСпец_AfterUpdate()
Me.Requery
End Sub
Private Sub ФИО_AfterUpdate()
Me.Requery
End Sub
ЛистингА.6 МодульформыГруппаСуб
Private Sub Form_Current()
On Error Resume Next
Me.Parent("ГруппаДляСвязи") = Me![№Группа]
DimtmpVarAsVariant
tmpVar = DLookup("Экзамен1", "КоличЭкз", "№Специальность=" &Me!№Специальность)
If Not IsNull(tmpVar) Then
Forms!УчебныйПроцесс!ЭкзаменСуб.Form!№Оценки1.Visible = True
Forms!УчебныйПроцесс!ЭкзаменСуб.Form!№Оценки1_Надпись.Caption = tmpVar
Forms!УчебныйПроцесс!ЭкзаменСуб.Form!№Оценки1_Надпись.Visible = True
Else
Forms!УчебныйПроцесс!ЭкзаменСуб.Form!№Оценки1.Visible = False
Forms!УчебныйПроцесс!ЭкзаменСуб.Form!№Оценки1_Надпись.Visible = False
EndIf
tmpVar = DLookup("Экзамен2", "КоличЭкз", "№Специальность=" &Me!№Специальность)
If Not IsNull(tmpVar) Then
Forms!УчебныйПроцесс!ЭкзаменСуб.Form!№Оценки2.Visible = True
Forms!УчебныйПроцесс!ЭкзаменСуб.Form!№Оценки2_Надпись.Caption = tmpVar
Forms!УчебныйПроцесс!ЭкзаменСуб.Form!№Оценки2_Надпись.Visible = True
Else
Forms!УчебныйПроцесс!ЭкзаменСуб.Form!№Оценки2.Visible = False
Forms!УчебныйПроцесс!ЭкзаменСуб.Form!№Оценки2_Надпись.Visible = False
EndIf
tmpVar = DLookup("Экзамен3", "КоличЭкз", "№Специальность=" &Me!№Специальность)
If Not IsNull(tmpVar) Then
Forms!УчебныйПроцесс!ЭкзаменСуб.Form!№Оценки3.Visible = True
Forms!УчебныйПроцесс!ЭкзаменСуб.Form!№Оценки3_Надпись.Caption = tmpVar
Forms!УчебныйПроцесс!ЭкзаменСуб.Form!№Оценки3_Надпись.Visible = True
Else
Forms!УчебныйПроцесс!ЭкзаменСуб.Form!№Оценки3.Visible = False
Forms!УчебныйПроцесс!ЭкзаменСуб.Form!№Оценки3_Надпись.Visible = False
EndIf
EndSub
Листинг А.7 Модуль формы ГруппаУчащийсяСуб
Private Sub OpenCard(№Учащийся As Variant)
On Error GoTo Err_OpenCard
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = "Учащийся"
stLinkCriteria = "[№Учащийся]=" & [№Учащийся]
DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_OpenCard:
Exit Sub
Err_OpenCard:
MsgBox Err.Description
Resume Exit_OpenCard
End Sub
Private Sub Form_Current()
On Error Resume Next
Me.Parent("ИмяДляСвязи") = Forms!УчебныйПроцесс!ГруппаУчащийсяСуб.Form!№Учащийся
End Sub
Private Sub ОткрЛичнКарт_Click()
On Error GoTo Err_ОткрЛичнКарт_Click
Call OpenCard(Me!№Учащийся)
Exit_ОткрЛичнКарт_Click:
Exit Sub
Err_ОткрЛичнКарт_Click:
MsgBox Err.Description
Resume Exit_ОткрЛичнКарт_Click
End Sub
Private Sub СоздЗаяв_Click()
On Error GoTo Err_СоздЗаяв_Click
Dim pathBase As String
Dim pathDot As String
Dim pathDoc As String
Dim WordObj As Word.Application
Dim rst As DAO.Recordset
Dim str As String
pathBase = CurrentProject.Path
pathDot = pathBase & "\Заявление\" & Nz(DLookup("ИмяШаблон", "ШаблоныДок", "КодШаблон=10"), "")
IfDir(pathDot) = "" Then
MsgBox "Шаблон документа не найден"
ExitSub
EndIf
pathDoc = pathBase& "\" &Nz(DLookup("ИмяФайлаДок", "ШаблоныДок", "КодШаблон=10"), "")
If Dir(pathDoc) <> "" Then
Kill pathDoc
End If
FileCopy pathDot, pathDoc
Set WordObj = CreateObject("Word.Application")
WordObj.Visible = True
WordObj.Documents.Open pathDoc
Set rst = CurrentDb.OpenRecordset("ЗапросСоздЗаяв")
rst.FindFirst "№Учащийся='" & Me!ГруппаДляСвязи & "'"
str = ""
With WordObj.ActiveDocument.Bookmarks
.Item("ОбрУч").Range.Text = Nz(DLookup("Вставка1", "ШаблоныДок", "КодШаблон=10"),"")
.Item("ФИО_Уч").Range.Text = Nz(DLookup("ФИО", "ЗапросСоздЗаяв"), " ")
.Item("ДатаРожд").Range.Text = Nz(DLookup("ДатаРождения", "ЗапросСоздЗаяв"), " ")
.Item("МестоРожд").Range.Text = Nz(DLookup("МестоРождения", "ЗапросСоздЗаяв"), " ")
.Item("СвидСер").Range.Text = Nz(DLookup("СвидСерия", "ЗапросСоздЗаяв"), " ")
.Item("СвидНом").Range.Text = Nz(DLookup("СвидНомер", "ЗапросСоздЗаяв"), " ")
.Item("СвидДата").Range.Text = Nz(DLookup("СвидДата", "ЗапросСоздЗаяв"), " ")
.Item("ОбрУч2").Range.Text = Nz(DLookup("Вставка1", "ШаблоныДок", "КодШаблон=10"), " ")
End With
WordObj.Activate
Set WordObj = Nothing
Exit_СоздЗаяв_Click:
Exit Sub
Err_СоздЗаяв_Click:
MsgBox Err.Description
Resume Exit_СоздЗаяв_Click
EndSub
Листинг А.8 Модуль формы Оплата
Private Sub Оплата_AfterUpdate()
If Me.NewRecord Then
Forms!УчебныйПроцесс!ГруппаДляСвязи = Me![№Группа]
End If
Forms!УчебныйПроцесс!Оплата.Form![№оплата].Requery
EndSub
Листинг А.9 Модуль формы Учащийся
Private Sub Form_Open(Cancel As Integer)
Me!РодФам = DLookup("РодПад", "Словарь", "ТипПоля =1 AND ИменПад='" & Me!ФамилияУчащийся & "'")
Me!ДатФам = DLookup("ДатПад", "Словарь", "ТипПоля =1 AND ИменПад='" & Me!ФамилияУчащийся & "'")
Me!РодИмя = DLookup("РодПад", "Словарь", "ТипПоля =2 AND ИменПад='" & Me!ИмяУчащийся & "'")
Me!ДатИмя = DLookup("ДатПад", "Словарь", "ТипПоля =2 AND ИменПад='" & Me!ИмяУчащийся & "'")
Me!РодОтч = DLookup("РодПад", "Словарь", "ТипПоля =3 AND ИменПад='" & Me!ОтчествоУчащийся & "'")
Me!ДатОтч = DLookup("ДатПад", "Словарь", "ТипПоля =3 AND ИменПад='" & Me!ОтчествоУчащийся & "'")
End Sub
Private Sub ДатИмя_AfterUpdate()
Dim ret As Boolean
ret = ОбнСлов(2, Me!ИмяУчащийся, Me!РодИмя, Me!ДатИмя)
End Sub
Private Sub ДатОтч_AfterUpdate()
Dim ret As Boolean
ret = ОбнСлов(3, Me!ОтчествоУчащийся, Me!РодОтч, Me!ДатОтч)
End Sub
Private Sub ДатФам_AfterUpdate()
Dim ret As Boolean
ret = ОбнСлов(1, Me!ФамилияУчащийся, Me!РодФам, Me!ДатФам)
End Sub
Function ОбнСлов(ТипСлов As Variant, ИмПад As Variant, РодПад As Variant, ДатПад As Variant) As Boolean
Dim ИменПад As Variant
Dim strSQL As String
ОбнСлов = False
If IsNull(РодПад) Or IsNull(ДатПад) Then Exit Function
ИменПад = DLookup("ИменПад", "Словарь", "ТипПоля =" & ТипСлов & " AND ИменПад='" & ИмПад & "'")
If IsNull(ИменПад) Then
strSQL = "Insert Into Словарь (ТипПоля, ИменПад, ДатПад, РодПад) VALUES (" & ТипСлов & ", '" & ИмПад & "', '" & РодПад & "', '" & ДатПад & "');"
Else
strSQL = "UPDATE Словарь SET Словарь.ДатПад = '" & ДатПад & "', Словарь.РодПад = '" & РодПад & "' " & _
"WHERE (((Словарь.ТипПоля)=" & ТипСлов & ") AND ((Словарь.ИменПад)='" & ИмПад & "'));"
End If
'MsgBox strSQL
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End Function
Private Sub РодИмя_AfterUpdate()
Dim ret As Boolean
ret = ОбнСлов(2, Me!ИмяУчащийся, Me!РодИмя, Me!ДатИмя)
End Sub
Private Sub РодОтч_AfterUpdate()
Dim ret As Boolean
ret = ОбнСлов(3, Me!ОтчествоУчащийся, Me!РодОтч, Me!ДатОтч)
End Sub
Private Sub РодФам_AfterUpdate()
Dim ret As Boolean
ret = ОбнСлов(1, Me!ФамилияУчащийся, Me!РодФам, Me!ДатФам)
End Sub
42
![](https://s.studizba.com/z.php?f=/templates/si/i/noavatar.png&w=100&h=100&t=1"){kind=avatar}
