VBA专题06-4：利用Excel中的数据自动化构建Word文档—Excel与Word整合示例1
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
'退出Word
.Quit
End With
'释放对象变量
Set wdApp = Nothing
End Sub