很多情况下,我们都需要从Excel中获取数据来创建Word报表文档。首先在Excel中分析数据,然后将分析结果导出到Word文档中发布。
技术实现方式:
1、创建Word模板,用来作为数据分析结果发布平台。在Word模板中,在每个插入点处定义书签。当然,对于只导入一两个数据表来说,这一步可选。
2、使用VBA,将Excel中的数据复制到Word文档,从而形成一份报表文档。
示例1:将Excel数据区域自动复制到Word文档
如果要将表改成文本格式,可以定义一个string
例如,将Data工作表中A1:E8的数据自动导出到Word文档中。
第1步:创建一份Word文档,本例中名为PasteTable.docx。在文档中,在想要粘贴数据的位置插入一个名为DataTable的书签。关闭该文档并将其与Excel文档放在相同的目录中。
第2步:在Excel VBE中,创建对Microsoft Word 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、本例来源于《Excel & Access Integration with Office 2007》。
2、设置要复制的区域时,使用了硬编码,可以根据需要调整。
3、当复制Excel数据表到Word中时,表格太宽往往导致格式问题,本例中调整表格列宽使用了一个技巧,即每列的宽度设置为表格的总宽度除以表格列数。
4、当粘贴数据到书签位置时,会覆盖书签,因此,重新创建书签以确保下次运行代码时书签仍在。
示例2:将多个Excel数据区域复制到Word文档
有时,需要将多个数据区域复制到Word文档,而这些数据区域大小不同。例如,在Data工作表中有两个大小不一个数据区域,要将这两个区域分别复制到同一个Word文档中形成报表文档。
第1步:创建一份Word文档,本例中名为PasteTable.docx。在文档中,在想要粘贴数据的位置分别插入名为DataTable1、DataTable2的书签。关闭该文档并将其与Excel文档放在相同的目录中。
第2步:将A1:E8命名为“rang1”,A11:F15命名为“rang2”。
第3步:在Excel VBE中,创建对Microsoft Word 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
'清空内存
Set wd = 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.Open Filename:=ThisWorkbook.Path & "Table.docx"
With .Selection
'到文档末尾,添加新段落
.EndKey Unit:=wdStory
.TypeParagraph
.Paste
End With
.ActiveDocument.Save
'退出Word
.Quit
End With
Set wdApp = Nothing
End Sub
说明:本示例来源于《Excel 2007 VBA参考大全》。
示例4:使用Excel数据填充Word书签位置
例如,下面的工作表,其中A2:B4命名为“rngBookmarkList”。
Word文档模板Bookmarks.dot,含有三个书签。
在Excel中运行代码后,书签位置的文本被取代。
Excel中的代码如下:
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) To UBound(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
说明:本示例来源于《Professional Excel Development(2nd Edition)》。
示例5:使用Excel中的数据结果生成不同的Word报告
如下图所示,在工作表中有很多数据,并使用数据透视表来分析这些数据。现在,要生成3份Word文档,分别报告Central、East、West这三个部门的业绩。
在工作表中,定义了一个名为rngBookMarks的书签区域I20:J22,与Word模板中的书签相对应。将单元格J20命名为ptrDivName,在程序中更新该单元格的内容。并且,该单元格内容更新后,使用查询VLookup函数来更新单元格J21和J22中的内容。
创建一个Word模板,在报告中需要更改的3个位置分别定义3个书签,如下图所示,书签与Excel单元格中的内容相一致。
运行代码后,每基于Word模板生成一份文档,都会修改模板中相应书签位置的内容,以生成具体的文档。
代码如下:
Sub WordGenerateDivisionSummaries()
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 In wksData.PivotTables(1).PivotFields("Division").PivotItems
'填充部门名单元格
wksData.Range("ptrDivName") = piDiv.Value
'重新计算工作表来更新部门的结果
wksData.Calculate
'从工作表中取数据填充模板中的书签
For Each rngBookmark In wksData.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 & "Salary Results - " & piDiv.Value & ".doc"
Next piDiv
'关闭Word文档
wrdDoc.Close
Set wrdDoc = Nothing
'关闭Word
wrdApp.Quit False
Set wrdApp = Nothing
MsgBox "Division Summaries Generated OK."
Exit Sub
ErrorHandler:
'显示错误号和错误描述
'并且在标题栏中注明程序
MsgBox "Error " & Err.Number & vbLf & Err.Description, _
vbCritical, "Routine: WordGenerateDivisionSummaries"
End Sub
说明:本示例来源于《Professional Excel Development(2nd Edition)》。
附:Word对象简介
Application
Word应用程序本身,通过该对象创建、打开和保存Word文档。
Document
Word文档对象
Bookmark
书签,包含在Document、Bookmarks集合中。要在书签位置放置内容,只须指定其Range属性的文本内容。若更改了书签的文本内容,则删除该书签。
Range
文档中某段连续区域。