Программирование на Visual Basic

04. Данный пример показывает как можно создать таблицу в Microsoft Word, используя vba в Word. При этом создается соединение внутри документа Word. Обратите внимание, что функция InsertDatabase отличается параметрами в разных версиях офиса.

Option Compare Database
Option Explicit
'#Const AccessVer = 2000
'#Const AccessVer = 2002
#Const AccessVer = 2003

'***************************************************************
'04.Пример. Как создать таблицу в документе Word ?
'***************************************************************

'==============================================================
'   Создание таблицы в документе Word
'   ---------------------------------
'   Для этого Вы должны создать в шаблоне la_automat.dot
'   закладку с имеенем Таблица. Например,
'   Вставка - Закладка ... - Имя закладки=Таблица
'   (Нажмите кнопку Добавить и сохраните шаблон)
'
Private Sub butNewWord_Click()
Dim app As Word.Application  'Приложение программы
Dim strDOC As String ' Имя документа
Dim strDOT As String ' Имя шаблона
Dim strMDB As String ' Имя базы данных
Dim rng As Word.Range ' Область данных
Dim tbl As Word.Table ' Таблица документа
Dim c As Word.Cell ' Ячейка таблицы
Dim i As Long ' Переменная

    On Error GoTo 999
    ' Определяем имена шаблона, документа и базы данных
    With Application.CurrentProject
        strDOT = .Path  "\"  "la_automat.dot"
        strDOC = .Path  "\"  "la_automat.doc"
        strMDB = .Path  "\"  .Name
    End With
    
    ' Управление документом Word
    Set app = New Word.Application 'Новое приложение Word
    app.Visible = True 'Отображаем документ
    app.Documents.Add strDOT 'Добавляем шаблон
    
    ' Выбираем закладку (позицию) таблицы
    Set rng = app.ActiveDocument.Bookmarks("Таблица").Range
    With rng
        .Collapse wdCollapseEnd
        ' Вставляем таблицу, используя запрос из базы данных
        #If AccessVer = 2000 Then
            .InsertDatabase _
                Style:=191, _
                LinkToSource:=False, _
                Connection:="Query ЗапросПримера04", _
                DataSource:=strMDB
        #ElseIf AccessVer = 2002 Then
            .InsertDatabase Format:=0, Style:=0, LinkToSource:=False, _
            Connection:= _
            "Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source="  strMDB  ";Mode=Read;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engi" _
            , SQLStatement:="SELECT * FROM `ЗапросПримера04`"  "", PasswordDocument _
            :="", PasswordTemplate:="", WritePasswordDocument:="", _
            WritePasswordTemplate:="", DataSource:= _
            strMDB, From:=-1, To:=-1, _
            IncludeFields:=True
        #Else
            .InsertDatabase Format:=0, Style:=0, LinkToSource:=False, _
                Connection:= _
                "Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source="  strMDB  ";Mode=Read;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLE" _
                , SQLStatement:="SELECT * FROM `ЗапросПримера04`"  "", PasswordDocument _
                :="", PasswordTemplate:="", WritePasswordDocument:="", _
                WritePasswordTemplate:="", DataSource:= _
                strMDB, From:=-1, To _
                :=-1, IncludeFields:=True
        #End If
        
        i = .Tables.Count ' Всего таблиц в данной области
        Set tbl = .Tables(i) ' Созданная таблица
        ' Форматируем всю таблицу
        tbl.Range.Font.Size = 10 ' Выбираем шрифт
        tbl.AutoFormat wdTableFormatGrid8 ' Выбираем авто-формат
       
        ' Вставляем колонку в начало таблицы
        tbl.Columns.Add tbl.Columns(1) ' Добавляем колонку
        i = 0
        For Each c In tbl.Range.Columns(1).Cells
            If i Then
                ' Изменяем данные
                c.Range.InsertAfter Format(i, "000") ' Вставить данные
                c.Range.ParagraphFormat.Alignment = wdAlignParagraphRight  'Правый формат
            Else
                ' Изменяем заголовок ячейки
                tbl.Range.Columns(1).Cells(1).Range.Text = "Пункт"
            End If
            i = i + 1
        Next c
        ' Форматируем заголовок, т.е. всю строку
        tbl.Rows(1).Select ' Выбираем заголовок
        With app.Selection
            .ParagraphFormat.Alignment = wdAlignParagraphCenter
            .Font.Name = "Arial" ' Имя шрифта
            .Font.Size = 10 ' Размер шрифта
        End With
        
        ' Добавляем новую строку
        tbl.Rows.Add ' Добавляем строку в конец таблицы
        With tbl.Cell(tbl.Rows.Count, 1) ' Выбираем 1 ячейку строки
          .Formula "=SUM(ABOVE)" ' Устанавливаем формулу
          .Shading.BackgroundPatternColorIndex = wdDarkRed ' Назначаем цвет фона
          .Range.Font.Bold = True ' Толщина (вес) текста
        End With
   End With
    
    app.ActiveDocument.SaveAs strDOC  ' Сохраняем файл
    ' app.Quit 'Закрываем приложение
    Exit Sub
999:
    MsgBox Err.Description  'Ошибка
    Err.Clear
    app.Quit
End Sub