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

fanjy

发布于 2019-10-09 14:50:57

1.6K0

发布于 2019-10-09 14:50:57

文章被收录于专栏：完美Excel完美Excel

示例2：自动复制Excel数据到Word文档指定位置

使用书签，可以方便地替换书签处的文本。例如，在下图9中的模板Bookmarks.dotx相应的文本位置定义了书签。

图9：在Word模板中定义书签

在Excel工作表中，包含有书签名数据及要在相应书签处放置的文本，即命名为rngBookmarkList的单元格区域A2:B4，如下图10所示。

图10：存放在工作表中需放置在书签处的文本数据

编写代码如下：

'示例来源于Professional ExcelDevelopment(2nd Edition)
Sub PopulateWordDoc1()
   Dim wrdApp As Word.Application
   Dim wrdDoc As Word.Document
   Dim sPath As String
   Dim vaBookmarks As Variant
   Dim lBookmark As Long
    '填充Bookmarks数组
   vaBookmarks = wksBookmarks.Range("rngBookmarkList").Value
    '开启Word程序
   Set wrdApp = CreateObject("Word.Application")
    '打开要填充的模板
   sPath = ThisWorkbook.Path & "\"
   Set wrdDoc = wrdApp.Documents.Add(Template:=sPath &"Bookmarks.dotx")
    '使用数组中的值填充模板中书签
   For lBookmark = LBound(vaBookmarks, 1) To UBound(vaBookmarks, 1)
       wrdDoc.Bookmarks(vaBookmarks(lBookmark, LBound(vaBookmarks,2))).Range.Text _
            = vaBookmarks(lBookmark,UBound(vaBookmarks, 2))
   Next lBookmark
    '保存填充的文本并关闭
   wrdDoc.SaveAs sPath & "Filled1.doc"
   wrdDoc.Close
   Set wrdDoc = Nothing
    '退出Word
   wrdApp.Quit False
   Set wrdApp = Nothing
End Sub

运行代码后的结果如下图11所示。

图11：使用Excel中的数据替换Word文本

此外，还可以借助于第二个启用宏的Word模板来实现，假设这个宏模板文档名为FillDocument.dotm，并放置在和Bookmarks.dotx文档与Excel工作簿相同的文件夹中。宏代码如下：

Public Sub FillDocument(ByValsTemplateName As String, _
 ByVal sSaveName As String, _
 ByVal vaBookmarks As Variant)
   Dim docToFill As Document
    Dim lBookmark As Long
   Set docToFill = Documents.Add(Template:=sTemplateName)
   For lBookmark = LBound(vaBookmarks, 1) To UBound(vaBookmarks, 1)
       docToFill.Bookmarks(vaBookmarks(lBookmark, LBound(vaBookmarks,2))).Range.Text = _
         vaBookmarks(lBookmark, UBound(vaBookmarks,2))
   Next lBookmark
   docToFill.SaveAs sSaveName
   docToFill.Close
End Sub
在Excel工作簿的标准模块中输入代码：
'示例来源于Professional ExcelDevelopment(2nd Edition)
Sub PopulateWordDoc2()
   Dim wrdApp As Word.Application
   Dim wrdDoc As Word.Document
   Dim sPath As String
   Dim vaBookmarks As Variant
    '填充Bookmarks数组
   vaBookmarks = wksBookmarks.Range("rngBookmarkList").Value
    '开启Word程序
   Set wrdApp = CreateObject("Word.Application")
    '打开模板
   sPath = ThisWorkbook.Path & "\"
   Set wrdDoc = wrdApp.Documents.Open(sPath &"FillDocument.dotm")
    '在Word中运行代码, 传递所需的数据
   wrdApp.Run "FillDocument", sPath &"Bookmarks.dotx", _
       sPath & "Filled2.doc", vaBookmarks
    '关闭Word文档
   wrdDoc.Close
   Set wrdDoc = Nothing
    '退出Word
   wrdApp.Quit False
   Set wrdApp = Nothing
End Sub

运行代码后，得到与上图11相同的结果。

相关文档：Excel应用实践20：使用Excel中的数据自动填写Word表格

本文参与腾讯云自媒体同步曝光计划，分享自微信公众号。

原始发表：2019-10-06，如有侵权请联系 cloudcommunity@tencent.com 删除

bookmarks