'Пример заполнения в Excel Word-го док-та через механизм закладки на VBA
Sub proc5()
Dim MainBookMarks() ' Массив с описанием параметров для BookMark в шаблоне договоров
Dim NumDog As String ' номер договора
Dim SumDog As Double
Dim Tb_PathTo, Tb_PathTo_New As String
On Error GoTo CBut_RunErr
CB_FileName = "ДОГОВ_Р ПОРУКИ_товар_грв.dot"
TB_Path = Worksheets("Лист8").Range("f27").Value 'путь к ф-лу -шаблону
Set fso = CreateObject("Scripting.FileSystemObject")
If Len(TB_Path) > 0 Then
Set Tb_PathTo1 = fso.GetFolder(TB_Path) 'Проверка существования пути
' StoredValue("TB_PATHTO").Value = CStr(Tb_PathTo)
Else
MsgBox "Не вказано путь до файлу"
End If
If Len(CB_FileName) > 0 Then
'Проверка существования файла
If Not IsEmpty(Tb_PathTo1) Then
ee = Tb_PathTo1 & "\" & Trim(CB_FileName)
Set TemplateName = fso.GetFile(ee)
Else
Set TemplateName = fso.GetFile(Trim(CB_FileName))
End If
'StoredValue("СB_FILENAME").Value = VBA.Trim(CB_fileName.Text)
Else
MsgBox "Не вказано _м'я файлу"
End If
NumDog = ""
Dim d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11, d12, d13, d14, d15, d16, d17, d18, d19, d20, _
d21, d22, d23, d24, d25, d26 As String
' Далее идет ветка с определ переменных памяти для вставки в соотв закладки
'...
' На пример, d8 = Sheets("анкета").Range("c12").Value & " " & Sheets("анкета").Range("c13").Value
'...
MainBookMarks = Array( _
"d1", d1, "d2", d2, "d3", d3, "d4", d4, _
"d5", d5, "d6", d6, "d7", d7, "d8", d8, "d9", d9, "d10", d10, _
"d11", d11, "d12", d12, "d13", d13, "d14", d14, "d15", d15, "d16", d16, _
"d17", d17, "d18", d18, "d19", d19, "d20", d20, _
"d21", d21, "d22", d22, "d23", d23, "d24", d24, "d25", d25)
If (d2 <> "") And (d3 <> "") And (d4 <> "") And (d5 <> "") And (d17 <> "") And (d18 <> "") Then
' Приступаем к формированию отчета. Отчет формируем в Word
Set DocWord = CreateObject("Word.application")
DocWord.Visible = False
Tb_PathTo_New = CStr(Mid(ee, 1, InStr(ee, " ") - 1) + "_1.doc")
Tb_PathTo = Trim(CStr(TB_Path)) & "\" & Trim(CStr(CB_FileName))
DocWord.Documents.Add Template:=Tb_PathTo, NewTemplate:=False
For i = 0 To UBound(MainBookMarks) Step 2
If DocWord.Documents(1).Bookmarks.Exists(MainBookMarks(i)) Then
DocWord.Documents(1).Bookmarks(MainBookMarks(i)).Select
DocWord.Selection.Text = MainBookMarks(i + 1)
' MsgBox "BOOKMARK (" + MainBookMarks(i) + "): ", vbInformation, "Значение параметра: " & MainBookMarks(i + 1)
Else
' Закладка в шаблоне не существует. Пропустим её ...
End If
Next i
DocWord.Selection.HomeKey Unit:=6 'wdStory - Переводим курсор в начало отчета
DocWord.Visible = True
End If
Exit Sub
CBut_RunErr:
Select Case Err.Number
Case 53
Set TemplateName = Nothing
Set fso = Nothing
MsgBox "Файл не знайдено"
Case 76
Set Tb_PathTo1 = Nothing
Set fso = Nothing
MsgBox "Путь не знайдено"
Case Else
MsgBox Err.Number & " = " & Err.Description
End Select
End Sub
