excel - 如何使用VBA将Excel数据插入Word，并导出为PDF？

Question

我有一张 Excel 工作表，其行中包含用于传真的信息。我需要循环遍历该工作表的填充行，并打开每行上的 Word 模板。模板打开后，我需要将 Word 文档中的占位符与工作表实际行中的信息交换，然后导出为 PDF。

Dim wb As Workbook
Set wb = ActiveWorkbook

Dim wsMailing As Worksheet
Set wsMailing = wb.Sheets("Mailing List")


''''''''''''''''''''''''''''''''''''''''''''''''
' SECTION  1: DOC  CREATION
''''''''''''''''''''''''''''''''''''''''''''''''

'sets up the framework for using Word 
Dim wordApp As Object
Dim wordDoc As Object
Dim owner, address1, address2, city, state, zipcode, insCo, fax1,  name, polnum As String


Dim n, j As Integer

Set wordApp = CreateObject("Word.Application")


'now we begin the loop for the mailing sheet that is being used

n = wsMailing.Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row

For j = 2 To n


    'first we choose which word doc gets used

        'opens the word doc that has the template  for sending out 

        Set wordDoc = wordApp.Documents.Open("C:\Users\cd\LEQ_VOC & Illustration Request.docx")

        'collects the  strings needed for the document
        owner = wsMailing.Range("E" & j).Value
        address1 = wsMailing.Range("F" & j).Value
        address2 = wsMailing.Range("G" & j).Value
        city = wsMailing.Range("H" & j).Value
        state = wsMailing.Range("I" & j).Value
        zipcode = wsMailing.Range("J" & j).Value
        insCo = wsMailing.Range("K" & j).Value
        fax1 = wsMailing.Range("L" & j).Value
        name = wsMailing.Range("M" & j).Value
        polnum = wsMailing.Range("N" & j).Value


        'fills in the word doc with the missing fields
        wordDoc.Find.Execute FindText:="<<InsuranceCompanyName>>", ReplaceWith:=insCo, Replace:=wdReplaceAll
        wordDoc.Find.Execute FindText:="<<Fax1>>", ReplaceWith:=fax1, Replace:=wdReplaceAll
        wordDoc.Find.Execute FindText:="<<OwnerName>>", ReplaceWith:=owner, Replace:=wdReplaceAll
        wordDoc.Find.Execute FindText:="<<Address1>>", ReplaceWith:=address1, Replace:=wdReplaceAll
        wordDoc.Find.Execute FindText:="<<Address2>>", ReplaceWith:=address2, Replace:=wdReplaceAll
        wordDoc.Find.Execute FindText:="<<City>>", ReplaceWith:=city, Replace:=wdReplaceAll
        wordDoc.Find.Execute FindText:="<<State>>", ReplaceWith:=state, Replace:=wdReplaceAll
        wordDoc.Find.Execute FindText:="<<ZipCode>>", ReplaceWith:=zipcode, Replace:=wdReplaceAll
        wordDoc.Find.Execute FindText:="<<Name>>", ReplaceWith:=name, Replace:=wdReplaceAll
        wordDoc.Find.Execute FindText:="<<PolicyNumber>>", ReplaceWith:=polnum, Replace:=wdReplaceAll



        'this section saves the word doc in the folder as a pdf
        wordDoc.SaveAs ("C:\Users\cd\" & wsMailing.Range("N" & j).Value & "_" & wsMailing.Range("C" & j).Value & ".pdf")



    'need to close word now that it has been opened before the next loop

    wordDoc.Documents(1).Close

Next

当我运行这个程序时，它挂起并且 Excel 卡住。我收到错误消息“Microsoft Excel 正在等待另一个应用程序完成 OLE 操作”，然后我必须重新启动计算机才能使其再次响应。

导致程序卡住的行是

Set wordDoc = wordApp.Documents.Open("C:\Users\cd\LEQ_VOC & Illustration Request.docx")

(当我运行此命令时，Microsoft Word 尚未启动并运行。它已完全关闭。)

Answer 1

首先，就我而言，在 VBA 编辑器中，我必须转到“工具”->“引用”，

...并启用 Microsoft Word 16.0 对象库以便能够正确访问 Excel 2016 对象模型。对于不同版本的 Office，要启用的模块可能有不同的版本号。

---

这里我稍微改变了结构，以简化事情，但本质上是 .Content失踪了。

所以代替: wordDoc.Find.Execute ， 这将是: wordDoc.Content.Find.Execute

所以它看起来像这样:

        With wordDoc.Content.Find
            .Execute FindText:="<<InsuranceCompanyName>>", ReplaceWith:=insCo, Replace:=wdReplaceAll
            .Execute FindText:="<<Fax1>>", ReplaceWith:=fax1, Replace:=wdReplaceAll
            .Execute FindText:="<<OwnerName>>", ReplaceWith:=owner, Replace:=wdReplaceAll
            .Execute FindText:="<<Address1>>", ReplaceWith:=address1, Replace:=wdReplaceAll
            .Execute FindText:="<<Address2>>", ReplaceWith:=address2, Replace:=wdReplaceAll
            .Execute FindText:="<<City>>", ReplaceWith:=city, Replace:=wdReplaceAll
            .Execute FindText:="<<State>>", ReplaceWith:=state, Replace:=wdReplaceAll
            .Execute FindText:="<<ZipCode>>", ReplaceWith:=zipcode, Replace:=wdReplaceAll
            .Execute FindText:="<<Name>>", ReplaceWith:=name, Replace:=wdReplaceAll
            .Execute FindText:="<<PolicyNumber>>", ReplaceWith:=polnum, Replace:=wdReplaceAll
        End With

---

接下来我必须更改的是 SaveAs PDF 功能。

这会保存一个扩展名为 .pdf 的文件，但当您实际尝试打开它时，它却打不开。这样保存的PDF文件，里面仍然是一个Word文档(.docx)。与将 Word 文档重命名为 PDF 相同。它仍然是一个Word文档。

这已被替换:

wordDoc.SaveAs ("C:\Users\cd\" & wsMailing.Range("N" & j).Value & "_" & wsMailing.Range("C" & j).Value & ".pdf")

这样:

wordDoc.ExportAsFixedFormat "C:\Users\cd\" & wsMailing.Range("N" & j).Value & "_" & wsMailing.Range("C" & j).Value & ".pdf", wdExportFormatPDF

---

最后要更改的是 Word 文档的关闭方式。 这不会关闭文档，因为wordDoc是唯一的文档，因此它不是文档集合，因此您无法引用 wordDoc 包含的第一个文档:

wordDoc.Documents(1).Close

相反，它很简单:

wordDoc.Close (wdDoNotSaveChanges)

wdDoNotSaveChanges必须添加以确保您的 Word 文档模板不会与第一个 PDF 文件的内容一起保存。

如果没有这个，您的第一个 PDF 将被创建并保存，同时保存的 Word 文档包含与 PDF 文件相同的内容。

在 For 循环的第二次迭代中，没有任何内容可以替换，因为所有占位符 <<...>>就会消失。

从此以后，所有 PDF 文件都将具有完全相同的内容。

我希望这会有所帮助。

---

再次将整个代码块作为一个单元进行复制和粘贴:

Dim wb As Workbook
Set wb = ActiveWorkbook

Dim wsMailing As Worksheet
Set wsMailing = wb.Sheets("Mailing List")


''''''''''''''''''''''''''''''''''''''''''''''''
' SECTION  1: DOC  CREATION
''''''''''''''''''''''''''''''''''''''''''''''''

'sets up the framework for using Word
Dim wordApp As Object
Dim wordDoc As Object
Dim owner, address1, address2, city, state, zipcode, insCo, fax1, name, polnum As String


Dim n, j As Integer

Set wordApp = CreateObject("Word.Application")

'now we begin the loop for the mailing sheet that is being used

n = wsMailing.Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row

For j = 2 To n


    'first we choose which word doc gets used

        'opens the word doc that has the template  for sending out

        Set wordDoc = wordApp.Documents.Open("C:\Users\cd\LEQ_VOC & Illustration Request.docx")

        'collects the  strings needed for the document
        owner = wsMailing.Range("E" & j).Value
        address1 = wsMailing.Range("F" & j).Value
        address2 = wsMailing.Range("G" & j).Value
        city = wsMailing.Range("H" & j).Value
        state = wsMailing.Range("I" & j).Value
        zipcode = wsMailing.Range("J" & j).Value
        insCo = wsMailing.Range("K" & j).Value
        fax1 = wsMailing.Range("L" & j).Value
        name = wsMailing.Range("M" & j).Value
        polnum = wsMailing.Range("N" & j).Value


        'fills in the word doc with the missing fields
        With wordDoc.Content.Find
            .Execute FindText:="<<InsuranceCompanyName>>", ReplaceWith:=insCo, Replace:=wdReplaceAll
            .Execute FindText:="<<Fax1>>", ReplaceWith:=fax1, Replace:=wdReplaceAll
            .Execute FindText:="<<OwnerName>>", ReplaceWith:=owner, Replace:=wdReplaceAll
            .Execute FindText:="<<Address1>>", ReplaceWith:=address1, Replace:=wdReplaceAll
            .Execute FindText:="<<Address2>>", ReplaceWith:=address2, Replace:=wdReplaceAll
            .Execute FindText:="<<City>>", ReplaceWith:=city, Replace:=wdReplaceAll
            .Execute FindText:="<<State>>", ReplaceWith:=state, Replace:=wdReplaceAll
            .Execute FindText:="<<ZipCode>>", ReplaceWith:=zipcode, Replace:=wdReplaceAll
            .Execute FindText:="<<Name>>", ReplaceWith:=name, Replace:=wdReplaceAll
            .Execute FindText:="<<PolicyNumber>>", ReplaceWith:=polnum, Replace:=wdReplaceAll
        End With


        ' this section saves the word doc in the folder as a pdf
        wordDoc.ExportAsFixedFormat "C:\Users\cd\" & wsMailing.Range("N" & j).Value & "_" & wsMailing.Range("C" & j).Value & ".pdf", _
                wdExportFormatPDF


    'need to close word now that it has been opened before the next loop

    wordDoc.Close (wdDoNotSaveChanges)

Next