如何基于Excel数据创建Word文档？-英雄云拓展知识分享

问：Excel善于数据分析和处理，而Word善于制作精美的报告。如果将二者结合起来，在Word中获得Excel数据来制作报表文档，那一定非常酷！通常，我们首先在Excel中分析和处理好数据，然后将结果导出到Word中，经过排版制作出一份有价值的精美文档。那末，如何使用VBA将Excel数据自动放置在Word文档中呢？

答：我们先谈谈实现思路，然后以不同情形下的实例来讲明。

技术线路

1. 创建Word模板，用来作为数据分析结果的发布平台。在Word模板中，在每一个插入点处定义内涵书签。固然，对只导入一两个数据表来讲，这一步可选。

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

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

以下图所示，需要将工作表Data中单元格区域A1:E8的数据自动导出到Word文档中。

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

第2步：在Excel VBE中，创建对MicrosoftWord Object Library的援用。

选择“工具——援用”，在援用对话框中，选择“Microsoft Word ×.0 Object Library”。

第3步：输入下面的代码

Sub PasteExcelTableIntoWord()

‘声明变量

Dim MyRange As Excel.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

‘内存清算

Set wd = Nothing

Set wdDoc = Nothing

Set WdRange = Nothing

End Sub

说明：

1. 代码中设置要复制的区域时，使用了硬编码，我们可以针对实际进行调剂。

2. 当复制Excel数据表到Word中时，表格太宽常常致使格式问题，代码中对表格列宽进行了调剂。这是调剂表格列宽的技能，即每列的宽度设置为表格的总宽度除以表格列数。

3. 当粘贴数据到书签位置时，会覆盖书签。因此，这种情况下，代码重新创建书签，以确保下次运行代码时书签仍在。

示例2：将多个Excel数据区域复制到Word文档

有时，需要将多个数据区域复制到Word文档，并且这些数据区域大小不同。举例来看，在工作表Data中有两个大小不一的数据区域，要将这两个区域分别复制到同一个Word文档中构成报表文档。

第1步：创建一份名为PasteTable.docx的Word文档，并在想要粘贴数据的位置分别插入名为DataTable1、DataTable2的书签。关闭该文档并将其与Excel文档放在相同的目录中。

第2步：将单元格区域A1:E8命名为“rang1”，单元格区域A11:F15命名为“rang2”。

第3步：在Excel VBE中，创建对MicrosoftWord Object Library的援用。

选择“工具——援用”，在援用对话框中，选择“Microsoft Word ×.0 Object Library”。

第4步：输入下面的代码

Sub PasteExcelTableIntoWord()

‘声明变量

Dim MyRange As Excel.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

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

‘清空内存

Setwd = Nothing

Set wdDoc = Nothing

Set WdRange = Nothing

End Sub

说明：

1. 此方法比较“笨”。由于在Excel中有多少表，就要命名多少个区域，然后在Word中就要建立相应数量的书签。

2. 由于表格大小不一，因此粘贴到Word中时，如果表格太宽，会伸出到Word页面以外。因此，这种情况下，在设置表格尺寸时，使用了一个固定尺寸来除以表格列数得到表格中每列的宽度，并自动调理。

3. 更改书签的文本信息后，会删除该书签。因此为了使代码重复运行，在粘贴数据表后，会重新插入书签。

示例3：复制工作表中的数据到Word文档

依然使用上两例中的数据，只是在Word中没有使用书签，而是直接将Excel数据复制到Word文档的末尾。

代码以下：

Sub CopyTableToWordDocument()

Dim wdApp As Word.Application

‘要复制的区域

ThisWorkbook.Sheets(“Data”).Range(“A1:E8”).Copy

‘建立与Word的连接

Set wdApp = New Word.Application

With wdApp

‘打开Word文档

.Documents.OpenFilename:=ThisWorkbook.Path & “\Table.docx”

With .Selection

‘到文档末尾,添加新段落

.EndKey Unit:=wdStory

.TypeParagraph

.Paste

End With

.ActiveDocument.Save

‘退出Word

.Quit

End With

Set wdApp = Nothing

End Sub

示例4：使用Excel数据填充到Word书签位置

以下图所示的工作表，其中A2:B4命名为“rngBookmarkList”。

Word文档模板Bookmarks.dot，含有3个书签。

在Excel中运行代码后，书签位置的文本被取代。

Excel VBE中的代码以下：

Sub PopulateWordDoc1()

Dim wrdApp As Word.Application

Dim wrdDoc As Word.Document

Dim sPath As String

Dim vaBookmarks As Variant

Dim lBookmark As Long

‘使用工作表数据填充书签数组

vaBookmarks = wksBookmarks.Range(“rngBookmarkList”).Value

‘开启Word

Set wrdApp =CreateObject(“Word.Application”)

‘打开模板准备填充

sPath = ThisWorkbook.Path &”\”

Set wrdDoc =wrdApp.Documents.Add(Template:=sPath & “Bookmarks.dot”)

‘使用数组中的数据填充模板中的书签

For lBookmark = LBound(vaBookmarks, 1) ToUBound(vaBookmarks, 1)

wrdDoc.Bookmarks(vaBookmarks(lBookmark,LBound(vaBookmarks, 2))).Range.Text = vaBookmarks(lBookmark,UBound(vaBookmarks, 2))

Next

‘保存被填充的文档并关闭

wrdDoc.SaveAs sPath &”Filled1.doc”

wrdDoc.Close

Set wrdDoc = Nothing

‘关闭Word

wrdApp.Quit False

Set wrdApp = Nothing

End Sub

示例5

：使用Excel中的数据分析结果生成不同的Word报告

以下图所示，在工作表中有很多数据，并使用数据透视表来分析这些数据。现在，要生成3份Word文档，分别报告Central、East、West这3个部门的事迹。

在工作表中，定义内涵了一个名为rngBookMarks的书签区域I20:J22，与Word模板中的书签相对应。将单元格J20命名为ptrDivName，在程序中更新该单元格的内容。并且，该单元格内容更新后，使用VLookup函数来更新单元格J21和J22中的内容。

创建一个Word模板，在报告中需要更改的3个位置分别定义内涵3个书签，以下图所示，书签与Excel单元格中的内容相一致。

运行代码后，每基于Word模板生成一份文档，都会修改模板中相应书签位置的内容，以生成具体的文档。

代码以下：

SubWordGenerateDivisionSummaries()

Dim wrdApp As Word.Application

Dim wrdDoc As Word.Document

Dim wrdrngBM As Word.Range

Dim piDiv As Excel.PivotItem

Dim rngBookmark As Excel.Range

Dim sPath As String

Dim sBookmarkName As String

On Error GoTo ErrorHandler

‘开启Word

Set wrdApp =CreateObject(“Word.Application”)

sPath = ThisWorkbook.Path &”\”

‘基于模板创建新的文档

Set wrdDoc =wrdApp.Documents.Add(Template:=sPath & “SalaryReport.dot”)

‘遍历数据透视表中的每一个部门

For Each piDiv InwksData.PivotTables(1).PivotFields(“Division”).PivotItems

‘填充部门名单元格

wksData.Range(“ptrDivName”) =piDiv.Value

‘重新计算工作表来更新部门的结果

wksData.Calculate

‘从工作表中取数据填充模板中的书签

For Each rngBookmark InwksData.Range(“rngBookmarks”).Rows

‘获得书签名

sBookmarkName =rngBookmark.Cells(1, 1).Value

‘获得书签逾越的Word区域

Set wrdrngBM =wrdDoc.Bookmarks(sBookmarkName).Range

‘设置区域中的文本(这将删除书签)

wrdrngBM.Text =rngBookmark.Cells(1, 2).Text

‘重新创建书签以便下次循环

wrdDoc.Bookmarks.Add sBookmarkName,wrdrngBM

Next rngBookmark

‘更新可能与书签相链接的字段

wrdDoc.Fields.Update

‘保存填充的文档

wrdDoc.SaveAs sPath & “SalaryResults – ” & piDiv.Value & “.doc”

Next piDiv

‘关闭Word文档

wrdDoc.Close

Set wrdDoc = Nothing

‘关闭Word

wrdApp.Quit False

Set wrdApp = Nothing

MsgBox “Division Summaries GeneratedOK.”

Exit Sub

ErrorHandler:

‘显示毛病号和毛病描写

‘并且在标题栏中注明程序

MsgBox “Error ” & Err.Number& vbLf & Err.Description, _

vbCritical, “Routine:WordGenerateDivisionSummaries”

End Sub

附：Word对象简介

Application

Word利用程序本身，经过该对象创建、打开和保存Word文档。

Document

Word文档对象

Bookmark

书签，包括在Document、Bookmarks汇聚中。要在书签位置放置内容，只须指定其Range属性的文本内容。若更改了书签的文本内容，则删除该书签。

Range

文档中某段连续区域。