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

时间：2019-08-23 15:24:38

标签： excel vba ms-word export-to-pdf

我有一个Excel工作表，该工作表的行中包含信息以进行传真。我需要遍历该工作表的填充行，然后在每一行上打开Word模板。打开模板后，我需要将Word doc中的占位符与工作表实际行中的信息交换，然后以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尚未启动并运行。它已完全关闭。）

1 个答案:

答案 0 :(得分：2)

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

enter image description here

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

enter image description here

这里，为了简化起见，我略微更改了结构，但实际上.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
相关问题
最新问题