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

'示例来源于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

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