Option Compare Database
Public Function PrintFormByTemplate(TmplName As String, ID As Long) As Boolean
'Сформировать и вывести форму по шаблону TmplName по записи о работнике с идентификатором ID
'Шаблоны хранятся в папке Templates в каталоге клиента в формате XlS
'Возвращает Истину, если формирование успешно, Ложь - в противном случае
Dim XL As Object, XLBook As Object, XLSheet As Object
Dim ClientDir As String, TmplFile As String, OutputDir As String, OutputFile As String, Pos As Long
Dim Rst As Object, SubRst As Object, StrN As Long
'Выбрать запись о работнике
Set Rst = CurrentDb.OpenRecordset("SELECT * FROM [Работники] WHERE ID=" & ID)
If Rst.EOF Then
MsgBox "Запись о работнике отсутствует в базе.", , "Ошибка вывода формы " & TmplName
PrintFormByTemplate = False
Exit Function
End If
'Создать копию файла шаблона для заполнения
ClientDir = CurrentDb.Name
Pos = Len(ClientDir)
Do While Mid(ClientDir, Pos, 1) <> "\"
Pos = Pos - 1
Loop
ClientDir = Left(ClientDir, Pos)
TmplFile = ClientDir & "Templates\" + TmplName + ".xls"
If Dir(TmplFile) = "" Then
MsgBox "Не найден файл шаблона.", , "Ошибка вывода формы " & TmplName
PrintFormByTemplate = False
Exit Function
End If
If Dir("C:\Temp", vbDirectory) = "" Then
MkDir "C:\Temp"
End If
OutputDir = "C:\Temp\Персонал.Оперативная статотчетность"
If Dir(OutputDir, vbDirectory) = "" Then
MkDir OutputDir
End If
OutputFile = OutputDir & "\" & TmplName & " " & Rst![Фамилия] & " " & Rst![Имя] & " " & Rst![Отчество] & " (таб. номер " & Rst![ТабНомер] & ").xls"
FileCopy TmplFile, OutputFile
'Создать объекты Excel
On Error GoTo OLEError
Set XL = CreateObject("Excel.Application")
On Error GoTo AnyError
Set XLBook = XL.Workbooks.Open(OutputFile)
'Вывод в конкретный шаблон
'Личная карточка работника (унифицированная форма Т-2)
If TmplName = "Т-2" Then
'1-й лист
Set XLSheet = XLBook.Worksheets(1)
'награды
StrN = 8
Set SubRst = CurrentDb.OpenRecordset("SELECT * FROM [_Награды] WHERE [Работник]=" & ID & " ORDER BY ID")
Do While Not SubRst.EOF
XLSheet.Cells(StrN, 1) = SubRst![Наименование]
XLSheet.Cells(StrN, 33) = SubRst![ДокументНаим]
XLSheet.Cells(StrN, 48) = SubRst![ДокументНомер]
XLSheet.Cells(StrN, 56) = SubRst![ДокументДата]
SubRst.MoveNext
StrN = StrN + 1
Loop
'конец награды
End If
'Конец личная карточка работника (унифицированная форма Т-2)
XLBook.Save
XL.Visible = True
PrintFormByTemplate = True
Exit Function
OLEError:
MsgBox "Microsoft Excel - не установлен.", , "Ошибка вывода формы " & TmplName
PrintFormByTemplate = False
Exit Function
AnyError:
MsgBox "Неопознанная ошибка.", , "Ошибка вывода формы " & TmplName
PrintFormByTemplate = False
Exit Function
End Function
|