Разработка АРМ сотрудника НОЧУ ДПО ЦПК Учебный центр ИнфоТеКС, страница 14
Описание файла
Файл "Разработка АРМ сотрудника НОЧУ ДПО ЦПК Учебный центр ИнфоТеКС" внутри архива находится в папке "Разработка АРМ сотрудника НОЧУ ДПО ЦПК Учебный центр ИнфоТеКС". Документ из архива "Разработка АРМ сотрудника НОЧУ ДПО ЦПК Учебный центр ИнфоТеКС", который расположен в категории "". Всё это находится в предмете "дипломы и вкр" из 12 семестр (4 семестр магистратуры), которые можно найти в файловом архиве РТУ МИРЭА. Не смотря на прямую связь этого архива с РТУ МИРЭА, его также можно найти и в других разделах. Архив можно найти в разделе "остальное", в предмете "диплом" в общих файлах.
Онлайн просмотр документа "Разработка АРМ сотрудника НОЧУ ДПО ЦПК Учебный центр ИнфоТеКС"
Текст 14 страницы из документа "Разработка АРМ сотрудника НОЧУ ДПО ЦПК Учебный центр ИнфоТеКС"
Приложение Б
Текст программы
Листинг Б.1 Модуль формы «Учебный процесс»
Private Sub Form_Activate()
Dim rst As DAO.Recordset
If Len(Me.OpenArgs) > 0 Then
Me!ГруппаДляСвязи = Me.OpenArgs
Set rst = Me!ГруппаСуб.Form.RecordsetClone
rst.MoveNext
rst.FindFirst "[№Группа]='" & Me!ГруппаДляСвязи & "'"
If Not rst.NoMatch Then
Me!ГруппаСуб.Form.Bookmark = rst.Bookmark
End If
rst.Close
End If
End Sub
Private Sub АктивностьГруппа_AfterUpdate()
If Me!АктивностьГруппа = 1 Then
Me!ГруппаСуб.Form.RecordSource = "УчебныйПроцессГруппа"
End If
If Me!АктивностьГруппа = 2 Then
Me!ГруппаСуб.Form.RecordSource = "УчебныйПроцессГруппа_открытые"
End If
If Me!АктивностьГруппа = 3 Then
Me!ГруппаСуб.Form.RecordSource = "УчебныйПроцессГруппа_закрытые"
End If
'MsgBox Me!ГруппаСуб.Form.RecordSource
Me!ГруппаСуб.Requery
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("ИмяШаблон", "ШаблоныДок", "КодШаблон=5"), "")
IfDir(pathDot) = "" Then
MsgBox "Шаблон документа не найден"
ExitSub
EndIf
pathDoc = pathBase& "\" &Nz(DLookup("ИмяФайлаДок", "ШаблоныДок", "КодШаблон=5"), "")
If Dir(pathDoc) <> "" ThenKill pathDoc
End If
FileCopy pathDot, pathDoc
Set WordObj = CreateObject("Word.Application")
WordObj.Visible = True
WordObj.Documents.Open pathDoc
Set rst = CurrentDb.OpenRecordset("СоздКарт")
With WordObj.ActiveDocument.Bookmarks
Продолжение Листинга Б.1
.Item("ОбрУч").Range.Text = Nz(DLookup("Вставка1", "ШаблоныДок", "КодШаблон=5"), " ")
.Item("ФамУч").Range.Text = Nz(DLookup("ФамилияУчащийся", "СоздКарт", "[№Учащийся]=" & Forms!УчебныйПроцесс!ГруппаУчащийсяСуб.Form!№Учащийся), " ")
.Item("ИмяУч").Range.Text = Nz(DLookup("ИмяУчащийся", "СоздКарт", "[№Учащийся]=" & Forms!УчебныйПроцесс!ГруппаУчащийсяСуб.Form!№Учащийся), " ")
.Item("ОтчУч").Range.Text = Nz(DLookup("ОтчествоУчащийся", "СоздКарт", "[№Учащийся]=" & Forms!УчебныйПроцесс!ГруппаУчащийсяСуб.Form!№Учащийся), " ")
End With
WordObj.Activate
Set WordObj = Nothing
Exit_Карт_Click:
Exit Sub
Err_Карт_Click:
MsgBox Err.Description
Resume Exit_Карт_Click
End Sub
Private Sub ГрафикЗанятий_Click()
Dim rst As DAO.Recordset2
Dim ЧасДень As Integer
Dim ДатаЗанятий As Date
Dim ФлагЗанятий As Boolean
If IsNull(Me!ГруппаСуб.Form!ДатаНачала) Then
MsgBox "Не введена дата начала занятий", vbInformation
Exit Sub
End If
If IsNull(Me!ГруппаСуб.Form!КолЧас) Then
MsgBox "Не введено количество часов", vbInformation
DoCmd.OpenForm "Специальность"
Exit Sub
End If
ВсегоЧас = Me!ГруппаСуб.Form!КолЧас
ДатаЗанятий = Me!ГруппаСуб.Form!ДатаНачала
ЧасДень = 4
Set rst = CurrentDb.OpenRecordset("График", dbOpenDynaset, dbSeeChanges)
Do While ВсегоЧас > 0
ФлагЗанятий = False
If Weekday(ДатаЗанятий, vbMonday) <= 5 Then ФлагЗанятий = True
'If IsNull(DLookup("ДатаВыходной", "ВыходнойРабочий", "ДатаВыходной=" & Format(ДатаЗанятий, "mm-dd-yyyy"))) Then ФлагЗанятий = True
'If IsNull(DLookup("ДатаРабочий", "РабочийВыходной", "ДатаРабочий=" & Format(ДатаЗанятий, "mm-dd-yyyy"))) Then ФлагЗанятий = False
'If IsNull(DLookup("ДатаПраздник", "Праздник", "ДатаПраздник=" & Format(ДатаЗанятий, "mm-dd-yyyy"))) Then ФлагЗанятий = False
If ФлагЗанятий Then
rst.AddNew
rst![№Группа] = Me!ГруппаСуб.Form![№Группа]
rst!ДатаЗанятий = ДатаЗанятий
rst!КолЧас = ЧасДень
ВсегоЧас = ВсегоЧас - ЧасДень
rst.Update
EndIf
ДатаЗанятий = DateAdd("d", 1, ДатаЗанятий)
Loop
rst.Close
Me!ГруппаСуб.Form!ДатаОкончания = DateAdd("d", -1, ДатаЗанятий)
Me!График.Requery
End Sub
Private Sub Свидетельство_Click()
On Error GoTo Err_Свидетельство_Click
DoCmd.OpenReport "Свидетельство", acViewPreview, , "[№Учащийся]=" & Forms!УчебныйПроцесс!ГруппаУчащийсяСуб.Form!№Учащийся
Exit_Свидетельство_Click:
ExitSub
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 WordTable As Word.Table
Dim WordRange As Word.Range
Dim WordDoc As Word.Document
Dim str As String
Dim strSQL As String
Dim countRec As Variant
pathBase = CurrentProject.Path
pathDot = pathBase & "\Шаблоны\" & Nz(DLookup("ИмяШаблон", "ШаблоныДок", "КодШаблон=8"), "")
IfDir(pathDot) = "" Then
MsgBox "Шаблон документа не найден"
ExitSub
EndIf
pathDoc = pathBase& "\" &Nz(DLookup("ИмяФайлаДок", "ШаблоныДок", "КодШаблон=8"), "")
If Dir(pathDoc) <> "" Then
Kill pathDoc
End If
FileCopy pathDot, pathDoc
Set WordObj = CreateObject("Word.Application")
WordObj.Visible = True
WordObj.Documents.Open pathDoc
WithWordObj.ActiveDocument.Bookmarks
.Item("НомГрупп").Range.Text = Nz(DLookup("№Группа", "Группа"), " ")
.Item("ДатаНачало").Range.Text = Nz(DLookup("ДатаНачала", "Группа"), " ")
.Item("ДатаКонец").Range.Text = Nz(DLookup("ДатаОкончания", "Группа"), " ")
End With
WordObj.Activate
Set WordObj = Nothing
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
Dim strSQL 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("ЗапросСоздЗаяв")
str = ""
With WordObj.ActiveDocument.Bookmarks
.Item("ОбрУч").Range.Text = Nz(DLookup("Вставка1", "ШаблоныДок", "КодШаблон=10"), " ")
.Item("ФИО_Уч").Range.Text = Nz(DLookup("ФИО", "ЗапросСоздЗаяв", "[№Учащийся]=" & Forms!УчебныйПроцесс!ГруппаУчащийсяСуб.Form!№Учащийся), " ")
.Item("ДатаРожд").Range.Text = Nz(DLookup("ДатаРождения", "ЗапросСоздЗаяв", "[№Учащийся]=" & Forms!УчебныйПроцесс!ГруппаУчащийсяСуб.Form!№Учащийся), " ")
End With
WordObj.Activate
Set WordObj = Nothing
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 WordTable As Word.Table
Dim WordRange As Word.Range
Dim WordDoc As Word.Document
Dim rst As DAO.Recordset
Dim str As String
Dim strSQL As String
Dim countRec As Variant
pathBase = CurrentProject.Path
pathDot = pathBase & "\Списки\" & Nz(DLookup("ИмяШаблон", "ШаблоныДок", "КодШаблон=6"), "")
IfDir(pathDot) = "" Then
MsgBox "Шаблон документа не найден"
ExitSub
EndIf
pathDoc = pathBase& "\" &Nz(DLookup("ИмяФайлаДок", "ШаблоныДок", "КодШаблон=6"), "")
If Dir(pathDoc) <> "" Then
Kill pathDoc
End If
FileCopy pathDot, pathDoc
Set WordObj = CreateObject("Word.Application")
WordObj.Visible = True
WordObj.Documents.Open pathDoc
strSQL = "SELECT СоздСпискаУд.* " & _
"FROMСоздСпискаУд " & _
"WHERE (((СоздСпискаУд.№Группа)='" & ГруппаДляСвязи & "'));"
Set rst = CurrentDb.OpenRecordset(strSQL, , dbReadOnly)
rst.MoveLast
rst.MoveFirst
With WordObj.ActiveDocument.Bookmarks
.Item("НомГруппы").Range.Text = Nz(rst![№Группа], " ")
End With
Set WordDoc = WordObj.ActiveDocument
Set WordTable = WordDoc.Tables(1)
countRec = 0
Do Until rst.EOF
WordTable.Rows.Add
countRec = countRec + 1
WordTable.Cell(countRec + 1, 1).Range.InsertAfter countRec
WordTable.Cell(countRec + 1, 2).Range.InsertAfter Nz(rst![№Учащийся], " ")
WordTable.Cell(countRec + 1, 3).Range.InsertAfter Nz(rst!СвидНомер, " ")
rst.MoveNext
Loop
