Вот текст из рабочей базы Access для заполнения шаблона Word:
'проверка наличия закладки в шаблоне Word
Private Function TrueBookmark(ByVal BookmarkName As String, ByVal wa As Word.Document) As Boolean
Dim i As Integer
For i = 1 To wa.Bookmarks.Count
If wa.Bookmarks(i).Name = BookmarkName Then
TrueBookmark = True
Exit For
End If
Next i
End Function
'Вставка текста
Private Sub SelectionText(ByVal SelTxt As Selection, ByVal StrTxt As String, ByVal Bld As Byte, ByVal Otstup As Boolean, Optional ByVal OtstAbsac As Boolean = False)
With SelTxt
If Otstup = True Then
.ParagraphFormat.LeftIndent = 12
Else
.ParagraphFormat.LeftIndent = 0
End If
Select Case Bld
Case 1
.Font.Bold = True
Case 0
.Font.Bold = False
End Select
If OtstAbsac = True Then
.ParagraphFormat.SpaceAfter = 3
Else
.ParagraphFormat.SpaceAfter = 0
End If
.TypeText StrTxt
End With
End Sub
Private Sub ЗаполнитьЗакладку(ByVal SelTxt As Selection, ByVal ИмяЗакладки As String, ByVal StrTxt As String)
With SelTxt
If TrueBookmark(ИмяЗакладки, .Document) Then
.GoTo What:=wdGoToBookmark, Name:=ИмяЗакладки 'Перейти на закладку
Call SelectionText(SelTxt, StrTxt, 2, False) 'Вставить текст
End If
End With
End Sub
'функция выгрузки в Word значений полей запроса через закладки в шаблоне
Function funOutputWordQuery(strPathDot As String, strPathWord As String) As Boolean
On Error GoTo Err_
Dim rst As DAO.Recordset
Dim i As Long
Dim DlgUser As Integer
Dim app As Word.Application
Dim Msg, ДатаДоговора
' Сохраним данные из формы в таблицу
If Me.Dirty Then
DoCmd.RunCommand acCmdSaveRecord
Debug.Print Me.[ПолноеФИОКлиента] 'Чтобы удостовериться, что стоим на нужной записи
If Err.Number <> 0 Then
Msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
Exit Function
End If
End If
' Проверим наличие шаблона
If Dir(strPathDot) = "" Then
Msg = "Файл шаблона " & strPathDot & " не найден!"
Msg = MsgBox(Msg, vbInformation + vbOKOnly)
funOutputWordQuery = False
Exit Function
End If
'проверяем наличие сформированного ранее документа
If Dir(strPathWord) <> "" Then 'если нашелся документ по заданому в strPathWord полному пути (вместе с именем)
DlgUser = MsgBox("Документ с таким именем ранее уже был создан. Заменить его?", vbYesNo, "admin")
If DlgUser = vbNo Then 'если пользователь выбрал Нет - то открываем прежний вариант документа
Set app = CreateObject("Word.Application") 'создаем объект Word, чтобы можно было работать с его методами и свойствами
With app
.Visible = True 'запускаем приложение Word
.Documents.Open strPathWord 'открываем документ (по пути в переменной strPathWord)
End With
Set app = Nothing 'уничтожаем переменную
funOutputWordQuery = True 'ставим флаг успешного выполнения функции
GoTo Exit_
End If
End If
' Новый документ, или перезаписываем имеющийся
Set app = New Word.Application 'делаем ссылку на объект Word для создания нового документа
app.Visible = True 'запускаем приложение Word
app.Documents.Add strPathDot 'присоединяем к объекту Word шаблон по заданному пути
With app.ActiveWindow.Selection 'делаем ссылку на активный документ - в данном случае тот что формируется
' Set rst = CurrentDb.OpenRecordset("qryOutWord", dbOpenSnapshot) 'открываем запрос на чтение
Set rst = Me.RecordsetClone
If rst.RecordCount > 0 Then 'если в запросе есть хоть одна строка
' Сначала заполним закладки, имя которых отличается от имен полей
ДатаДоговора = rst.Fields("Дата")
ДатаДоговора = Format(ДатаДоговора, "dd mmmm yyyy г.")
Call ЗаполнитьЗакладку(app.ActiveWindow.Selection, "ДатаДоговора", Nz(ДатаДоговора, "______________"))
Call ЗаполнитьЗакладку(app.ActiveWindow.Selection, "ПолноеФИОКлиента1", Nz(rst.Fields("ПолноеФИОКЛиента"), "______________"))
For i = 0 To rst.Fields.Count - 1 'создаем цикл перебора столбцов запроса
If TrueBookmark(rst.Fields(i).Name, .Document) Then
.GoTo What:=wdGoToBookmark, Name:=rst.Fields(i).Name 'Перейти на закладку
Call SelectionText(app.ActiveWindow.Selection, Nz(rst.Fields(i), "______________"), 2, False) 'Вставить текст
End If
Next i
rst.Close 'закрываем рекордсет - при этом автоматически уничтожается и переменная rst
End If
'Чистим незаполненные закладки
With .Bookmarks
For i = .Count To 1 Step -1
'если имя Bookmark совпадает с его содержимым
If .Item(i).Name = .Item(i).Range.Text Then
'Удаляем содержимое (вместе с ним удаляется и сама Bookmark)
.Item(i).Range.Text = ""
End If
Next i
End With
app.ActiveDocument.SaveAs strPathWord 'сохраняем созданный документ по заданному пути strPathWord
End With
Set app = Nothing 'уничтожаем переменную
funOutputWordQuery = True 'ставим флаг успешного выполнения функции
Exit_:
Exit Function
Err_:
funOutputWordQuery = False
Err.Clear
app.Quit
Resume Exit_
End Function