问题描述
我有一个Excel工作表,该工作表的行中包含信息以进行传真.我需要遍历该工作表的填充行,然后在每一行上打开Word模板.打开模板后,我需要将Word doc中的占位符与工作表实际行中的信息交换,然后以PDF格式导出.
I have an excel sheet that has information in its rows for faxing. I need to loop through the populated rows of that sheet, and open the Word template on each row. Once template is open, I need to swap placeholders in the Word doc with the information in the actual row of the worksheet, then export is as 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操作",然后我必须重新启动计算机以使其再次响应.
When I run this, it gets hung up and Excel freezes. I get the error message "Microsoft Excel is waiting for another application to complete an OLE action" and then I have to restart the computer to get it to respond again.
导致程序冻结的行是
Set wordDoc = wordApp.Documents.Open("C:\Users\cd\LEQ_VOC & Illustration Request.docx")
(运行此程序时,Microsoft Word尚未启动并运行.它已完全关闭.)
(Microsoft Word is not already up and running when I run this. It is completely closed.)
推荐答案
首先,在我的VBA编辑器中,我必须转到工具"->引用",
First of all, in my case in the VBA editor I had to go to Tools -> References,
...并启用Microsoft Word 16.0对象库以能够正确访问Excel 2016对象模型.对于不同版本的Office,要启用的模块可能具有不同的版本号.
...and enable Microsoft Word 16.0 Object Library to be able to properly access Excel 2016 Object Model. With different version of Office, the module to be enabled might have a different version number.
这里,为了简化起见,我略微更改了结构,但实际上缺少了 .Content
.
Here I have changed the structure slightly, to simplify things, but essentially .Content
was missing.
所以代替: wordDoc.Find.Execute
, 这将是: wordDoc.Content.Find.Execute
So instead of: wordDoc.Find.Execute
, it would be: 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.
Next thing I had to change was the SaveAs PDF thing.
这会保存一个扩展名为.pdf的文件,但是当您实际尝试打开它时,它不会打开.这样保存的PDF文件仍然是Word文档(.docx).与将Word文档重命名为PDF相同.仍然是Word文档.
This saves a file with .pdf extension, but when you actually try to open it, it doesn't open. A PDF file saved this way, inside is still a Word Document (.docx). Same as if you rename a Word Document to PDF. It is still a Word Document.
已替换:
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 :
Last thing to change was how the Word Document is closed.This doesn't close the document, because
wordDoc
is the one and only document, so it is not a collection of documents, therefore you cannot refer to the first document contained by wordDoc
:
wordDoc.Documents(1).Close
相反,它很简单:
wordDoc.Close (wdDoNotSaveChanges)
wdDoNotSaveChanges
必须添加,以确保您的Word文档模板不会与第一个PDF文件的内容一起保存.
wdDoNotSaveChanges
had to be added to make sure that your Word document template doesn't get saved with the content of the first PDF file.
否则,将创建并保存您的第一个PDF文件,并保存与Word文件相同的Word文档.
Without this your first PDF would get created and saved, together with the Word document saved containing the same as the PDF file.
在For循环的第二次迭代中,没有什么可替换的,因为所有占位符
将消失.<< ...>
In the second iteration of the For Loop there would be nothing to replace because all the placeholders <<...>>
would be gone.
从那时起,所有PDF文件的内容将完全相同.
From then on all PDF files would have exactly the same content.
我希望这会有所帮助.
再次将整个代码块作为一个单元进行复制和粘贴:
The whole code block again to help copy and paste as one unit:
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
这篇关于如何使用VBA将Excel数据插入Word并将其导出为PDF?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!