VBA, MS Access MS Access в примерах

MS Word - Экспорт данных формы в MS Word (простой пример)

Код из примера:


Private Sub cmdToWord_Click()
' es - 11.08.2019
'----------------------------------------------------------------
' Экспорт данных формы в MS Word простенько
'   В шаблоне должны быть закладки:
'   - "Фамилия"
'   - "Имя"
'   - "Отчество"
' ... - закладки создаются в меню "Вставка" (Insert).
'----------------------------------------------------------------
' Создано по мотвам топика:
' http://www.cyberforum.ru/ms-access/thread2489879.html
'----------------------------------------------------------------

Dim app As Object    ' Word.Application  'Приложение программы
Dim strDOC As String ' Имя документа
Dim strDOT As String ' Имя шаблона

On Error GoTo cmdToWord_Click_Err

    ' Определяем пути шаблона и документа (отн. тек. папки приложения )
    With Application.CurrentProject
        strDOT = .Path & "\" & "Word_Tempalate_03.dot" 'Шаблон
        strDOC = .Path & "\" & "Exported.doc"          'Создаваемый (по шаблону) документ
    End With
    
    ' Управление документом Word
    Set app = CreateObject("Word.Application") 'Новое приложение Word
    app.Documents.Add strDOT                   'Добавляем (зпгружаем) шаблон
    app.Visible = True                         'Отображаем приложение
    app.Activate
    
    With app.ActiveDocument  'Выбираем активный (только что созданный) документ
        'Разносим данные текущей записи формы по закладкам:
        .Bookmarks.Item("Фамилия").Range.Text = Me!txtФамилия & ""
        .Bookmarks.Item("Имя").Range.Text = Me!txtИмя & ""
        .Bookmarks.Item("Отчество").Range.Text = Me!txtОтчество & ""
        .SaveAs strDOC ' Сохраняем файл по заданному пути
    End With
    
    'app.Quit 'Закрываем приложение (если нужно)

cmdToWord_Click_End:
    On Error Resume Next ' Отключаем ошибки
    Set app = Nothing
    Err.Clear
    Exit Sub

cmdToWord_Click_Err:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub cmdToWord_Click.", vbCritical, "Произошла ошибка!"
    Err.Clear
    Resume cmdToWord_Click_End

End Sub


Picture

Picture




Скачать

MSA-2007 ( 88 kB) Пример


Назад ToTop
L.E. 11.08.2019
Рейтинг@Mail.ru