我修改了这个VBA代码,将所有标记文本替换为Excel工作表中的内容。
这与Word文档中的主要内容的预期效果相同。
它不搜索/替换Word文档标题中的文本。
如何查找和替换页眉中的文本?
Dim CustRow, CustCol, TemplRow As Long
Dim DocLoc, TagName, TagValue, TemplName, FileName As String
Dim CurDt, LastAppDt As Date
Dim WordDoc, WordApp As Object
Dim WordContent, WordHeaderFooter As Word.Range
With Sheet106
TemplRow = .Range("B3").Value 'Set Template Row
TemplName = .Range("J3").Value 'Set Template Name
DocLoc = .Range("E" & TemplRow).Value 'Word Document Filename
'Open Word Template
On Error Resume Next 'If Word is already running
Set WordApp = GetObject("Word.Application")
If Err.Number <> 0 Then
'Launch a new instance of Word
Err.Clear
'On Error GoTo Error_Handler
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True 'Make the application visible to the user
End If
CustRow = 4
Set WordDoc = WordApp.Documents.Open(FileName:=DocLoc, ReadOnly:=False) 'Open Template
For CustCol = 16 To 180 'Move Through all Columns
TagName = .Cells(3, CustCol).Value 'Tag Name
TagValue = .Cells(CustRow, CustCol).Value 'Tag Value
With WordDoc.Content.Find
.Text = TagName
.Replacement.Text = TagValue
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll 'Find & Replace all instances
End With
Next CustCol
If .Range("J1").Value = "PDF" Then
FileName = ThisWorkbook.Path & "\" & .Range("Q" & CustRow).Value & _
"_" & .Range("P" & CustRow).Value & ".pdf" 'Create full filename & Path with current workbook location, Last Name & First Name
WordDoc.ExportAsFixedFormat OutputFileName:=FileName, ExportFormat:=wdExportFormatPDF
WordDoc.Close False
Else: 'If Word
FileName = ThisWorkbook.Path & "\" & .Range("Q" & CustRow).Value _
& "_" & .Range("P" & CustRow).Value & ".docx"
WordDoc.SaveAs FileName
End If
End With
End Sub
1条答案
按热度按时间tkqqtvp11#
蒂姆·威廉姆斯和我都推荐乔纳森·韦斯特、彼得·休伊特、道格·罗宾斯和格雷格·马克西的MVP web page。
这是Word代码,因此您需要将其标记到WordDoc对象而不是ActiveDocument。
查找或替换任何地方的文本的完整代码有点复杂。因此,让我们一次一个步骤来更好地说明这个过程。在许多情况下,简单的代码足以完成工作。
步骤1
下面的代码循环遍历活动文档中的每个StoryRange,并将指定的.Text替换为.Replacement.Text:
(Note对于已经熟悉VBA的用户:而如果您使用Selection.Find,则必须指定所有的Find和Replace参数,例如.Forward = True,因为这些设置是从Find和Replace对话框的当前设置中获取的,这些设置是“粘滞的”,如果使用[Range].Find -如果您不在代码中指定参数值,则参数使用默认值,则不需要这样做)。
上面这个简单的宏有缺点,它只作用于11个StoryType中每一个的“第一个”StoryRange(即,第一个页眉、第一个文本框等)。虽然文档只有一个wdMainTextStory StoryRange,但它可以在某些其他StoryType中有多个StoryRange。例如,如果文档包含页眉和页脚未链接的节,或者文档包含多个文本框,这些StoryType将有多个StoryRanges,并且代码将不对第二个和后续StoryRanges起作用。2更复杂的是,如果文档包含未链接的页眉或页脚,并且其中一个页眉或页脚为空,则VBA可能难以“跳转”空页眉或页脚并处理后续页眉和页脚。
第二步
要确保代码作用于每个StoryType中的每个StoryRange,您需要:
x一个一个一个一个x一个一个二个x
还有一个问题。与查找和替换实用程序一样,上面的代码可能会丢失嵌套在不同StoryType/StoryRange中的一个StoryType/StoryRange中包含的任何文本。虽然wdMainTextStory StoryRange中的嵌套StoryType/StoryRange不会出现此问题,但页眉和页脚类型StoryRanges中会出现此问题。例如,位于页眉或页脚中的文本框。
步骤3
幸运的是,Jonathan West为这种嵌套StoryRanges的问题提供了一个解决方案。该解决方案利用了文本框和其他绘图形状包含在文档的ShapeRange集合中这一事实。因此,我们可以检查六个页眉和页脚StoryRanges中每个的ShapeRange是否存在形状。如果找到了形状,则检查每个形状是否存在文本,最后,如果Shape包含文本,则将搜索范围设置为该Shape的. TextFrame. TextRange。
最后一个宏包含了在文档中“任意位置”查找和替换文本的所有代码。添加了一些增强功能,使应用所需的查找和替换文本字符串变得更加容易。
注意:粘贴之前,请务必将代码文本转换为纯文本:如果直接从Web浏览器粘贴,空格将被编码为不间断空格,对于VBA而言,这些空格不是“空格”,将导致编译或运行时错误。另外:请注意此代码中的长行。当您将此代码粘贴到VBA编辑器中时,粘贴内容中的任何地方都不应出现可见的红色。如果出现,请小心地尝试将顶部的红色行与其下方的红色行连接起来(不要删除任何可见字符)。