很多情况下,我们都需要从Excel中获取数据来创建Word报表文档。首先在Excel中分析数据,然后将分析结果导出到Word文档中发布。
技术实现方式:
1、创建Word模板,用来作为数据分析结果发布平台。在Word模板中,在每个插入点处定义书签。当然,对于只导入一两个数据表来说,这一步可选。
2、使用VBA,将Excel中的数据复制到Word文档,从而形成一份报表文档。
示例1:将Excel数据区域自动复制到Word文档例如,将Data工作表中A1:E8的数据自动导出到Word文档中。
第1步:创建一份Word文档,本例中名为PasteTable.docx。在文档中,在想要粘贴数据的位置插入一个名为DataTable的书签。关闭该文档并将其与Excel文档放在相同的目录中。
第2步:在Excel VBE中,创建对Microsoft Word Object Library的引用。选择“工具——引用”,在引用对话框中,选择“Microsoft Word ×.0 Object Library”。
第3步:输入下面的代码
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
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