我曾使用此代码在 Word 文档中分别查找和替换 A 列和 B 列中的项目。问题是代码无法找到 Word 文档页眉和页脚中的项目。
有人能解决这个问题吗?
Option Explicit
Public Sub WordFindAndReplace()
Dim ws As Worksheet, msWord As Object, itm As Range
Set ws = ActiveSheet
Set msWord = CreateObject("Word.Application")
With msWord
.Visible = True
.Documents.Open "F:\Test folder\TestFolder\Test.docx"
.Activate
With .ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
For Each itm In ws.UsedRange.Columns("A").Cells
.Text = itm.Value2 'Find all strings in col A
.Replacement.Text = itm.Offset(, 1).Value2 'Replacements from col B
.MatchCase = False
.MatchWholeWord = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
Next
End With
.Quit SaveChanges:=True
End With
End Sub
答案1
Word 由多个数据层组成,它们被称为 Stories。您当前的代码仅搜索 MainTextStory 层。为了让您的代码搜索所有层,您需要合并类似下面我的示例的内容:
Sub FindInAllStories()
Dim rng As Word.Range, iShp As Word.InlineShape
For Each rng In ActiveDocument.StoryRanges
Debug.Print rng.StoryType, rng.InlineShapes.Count, rng.ShapeRange.Count
Next
End Sub
如果您只想搜索特定的故事范围,您可以使用 StoryType 命令并指定要搜索的特定范围。有关可用故事类型的列表,请查看此 Microsoft 文章:
https://docs.microsoft.com/en-us/office/vba/api/word.wdstorytype
答案2
最好的选择可能是遍历文档的各个部分并将内容放入字符串中并对其进行操作:
For Each oSection In ActiveDocument.Sections
For Each oHeader In oSection.Headers
Set oRng = oHeader.Range
myString = oRng.Text
'manipulate string here
oRng.Text = myString
'if you expect text boxes in the headers you must use the following too
For Each oShp In oHeader.Shapes
If oShp.TextFrame.HasText Then
myString = oShp.TextFrame.TextRange.Text
'manipulate string here
End If
Next oShp
Next oHeader
Next oSection
oSection.Footers
你也需要循环
答案3
我终于找到了一种方法来实现这一点。我将在此处发布代码:
Sub Generar_Informe()
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdRng As Word.Range
Dim j As Integer
Dim datos(0 To 1, 0 To 30) As String '(columna,fila)
Dim ruta As String
ruta = "P:\HVBG\Informes\Documentos\INFORME_LHVBG_NEXIB_00X_YY.dotx"
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
Set wdDoc = wdApp.Documents.Add(ruta)
For j = 0 To UBound(datos, 2)
datos(0, j) = Hoja1.Cells(j + 4, 1) 'what to find
datos(1, j) = Hoja1.Cells(j + 4, 2) 'what to replace
For Each wdRng In wdDoc.StoryRanges 'loop through
With wdRng.Find
.Text = datos(0, j)
.Replacement.Text = datos(1, j)
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Next wdRng
Next j
Set wdApp = Nothing: Set wdDoc = Nothing: Set wdRng = Nothing
End Sub