通过 Excel 中的页眉和页脚在 Word 中查找和替换(也)

通过 Excel 中的页眉和页脚在 Word 中查找和替换(也)

我曾使用此代码在 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

相关内容