VBA专题06-4：利用Excel中的数据自动化构建Word文档—Excel与Word整合示例1

使用VBA自动从Excel中获取数据来创建Word报表文档，一般按照以下步骤：

1.创建Word文档模板，用来作为数据分析结果发布平台。在模板中，在每个要插入数据的位置定义书签。当然，对于只导入一两个数据表来说，这一步可选。

2.使用VBA，将Excel中的数据复制到Word文档，从而形成一份报表文档。

示例1：自动复制Excel数据区域到Word文档

本示例使用前期绑定，即首先要在VBE中设置对Word对象库的引用。

示例数据工作表如下图7所示。

图7：示例数据工作表

创建一个名为PasteTable.docx的文档，并在想要粘贴数据的位置插入一个名为DataTable的书签。关闭该文档并将其与示例Excel文档放在相同的目录中。

在Excel文档的VBE编辑器中，插入一个标准模块，输入代码：

Sub PasteExcelDataToWord()
    '声明变量
   Dim MyRange As Range
   Dim wd As Word.Application
   Dim wdDoc As Word.Document
   Dim WdRange As Word.Range
    '复制区域
   Set MyRange = Sheets("Data").Range("A1:E8")
   MyRange.Copy
    '打开Word文档
   Set wd = New Word.Application
   Set wdDoc = wd.Documents.Open(ThisWorkbook.Path &"\PasteTable.docx")
   wd.Visible = True
    '将光标移至书签位置
   Set WdRange = wdDoc.Bookmarks("DataTable").Range
    '删除旧表格粘贴新表格
   On Error Resume Next
   WdRange.Tables(1).Delete
   WdRange.Paste
    '调整列宽
   WdRange.Tables(1).Columns.SetWidth _
   (MyRange.Width / MyRange.Columns.Count), wdAdjustSameWidth
    '重新插入书签
   wdDoc.Bookmarks.Add "DataTable", WdRange
    '保存并退出Word
   wdDoc.Save
   wd.Quit
    '释放对象变量
   Set wd = Nothing
   Set wdDoc = Nothing
   Set WdRange = Nothing
End Sub

复制Excel数据到Word中时，表格太宽往往会导致格式问题，代码中使用了一个技巧来调整表格列宽，即每列的宽度设置为表格的总宽度除以表格列数。此外，当在书签位置粘贴数据时，会覆盖掉书签，因此，重新创建该书签以确保下次运行代码时能正常运行。

有时，需要将Excel工作表中的多个数据区域复制到Word文档，并且这些数据区域大小还不相同。例如，在Data工作表中有两个大小不一的数据区域（如下图8所示），要将这两个区域分别复制到同一个Word文档中形成报表文档。

图8：示例数据工作表

与上面的示例一样，先创建一个名为PasteTable.docx的文档，并在想要粘贴数据的位置分别插入名为DataTable1、DataTable2的书签。关闭该文档并将其与示例Excel文档放在相同的目录中。

将图8所示示例工作表中的单元格区域A1:E8命名为“rang1”，A11:F15命名为“rang2”。在Excel文档的VBE编辑器中，插入一个标准模块，输入代码：

Sub PasteExcelDataToWordPlus()
    '声明变量
   Dim MyRange As Range
   Dim wd As Word.Application
   Dim wdDoc As Word.Document
   Dim WdRange As Word.Range
   Dim i As Long
    '打开Word文档
   Set wd = New Word.Application
   Set wdDoc = wd.Documents.Open(ThisWorkbook.Path &"\PasteTable.docx")
   wd.Visible = True
   On Error Resume Next
    '遍历命名区域
    '并将其数据复制到Word文档相应的书签位置
   For i = 1 To 2
       Set MyRange = Names("rang" & i).RefersToRange
       MyRange.Copy
       Set WdRange = wdDoc.Bookmarks("DataTable" & i).Range
       WdRange.Tables(1).Delete
       WdRange.Paste
        '调整表格列宽
       WdRange.Tables(1).Columns.SetWidth _
         (450 / MyRange.Columns.Count), wdAdjustNone
        '恢复书签
       wdDoc.Bookmarks.Add "DataTable" & i, WdRange
   Next i
    '保存并关闭Word
   wdDoc.Save
   wd.Quit
    '释放对象变量
   Set wd = Nothing
   Set wdDoc = Nothing
   Set WdRange = Nothing
End Sub

这里使用的方法比较“笨”，因为在Excel中有多少数据区域，就要命名多少个区域，并且在Word中也要建立相应数量的书签。其实，如果不需要将数据复制到Word文档的指定位置的话，那么在本文前面已经给出了一个简单的代码框架，就是直接将Excel数据依次复制到Word文档的末尾。代码如下：

Sub CopyDataToWord()
   Dim wdApp As Word.Application
   Dim myRange As Range
   Dim i As Long
    '建立与Word的连接
   Set wdApp = New Word.Application
   With wdApp
        '打开Word文档
       .Documents.Open Filename:=ThisWorkbook.Path &"\PasteTable.docx"
       For i = 1 To 2
            '复制相应区域的数据
            Set myRange =Names("rang" & i).RefersToRange
           myRange.Copy
            With .Selection
                '到文档末尾,添加新段落
                .EndKey Unit:=wdStory
                .TypeParagraph
                '粘贴数据
                .Paste
            End With
       Next i
       .ActiveDocument.Save