如何在VBA for Word中搜索/查找多种格式样式?

时间:2019-07-11 21:41:04

标签: vba ms-word

在此先感谢您抽出宝贵的时间阅读此书。

我想在Word 2013中编写“查找”功能,以搜索多种样式的特定单词。甚至不确定这是否可行,因为Word在高级查找->更多->格式->样式中没有该选项。它仅允许过滤一种样式。

我的目标是能够在样式“标题1”到“标题9”中找到段落标记(语法:^ p)。

Sub AppendixFix()

    ' Declaring variables
    Dim multiStyles As String, i As Integer
    multiStyles = "Heading 1, Heading 2, Heading 3, Heading 4, Heading 5, Heading 6, Heading 7, Heading 8, Heading 9"

    ' Start at the top of document and clear find formatting
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting

    ' Navigate to Appendix section
    Selection.Find.Style = ActiveDocument.Styles("Heading 1")
    With Selection.Find
        .Text = "Appendix"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .Execute
    End With

    ' Loop until find is not found and limit to 1000 counts
    Do While Selection.Find.Found = True And i < 1000
        i = i + 1
        ' Add text to the beginning of each line
        Selection.HomeKey Unit:=wdLine
        Selection.TypeText Text:=" *Test* "
        ' Navigate to the next heading by looking at following paragraph mark
        Selection.Find.Style = ActiveDocument.Styles(multiStyles)
        With Selection.Find
            .Text = "^p"
            .Forward = True
            .Wrap = wdFindStop
            .Format = True
            .Execute
            .Execute
        End With
    Loop

End Sub

我希望代码在第一个“附录”标题处开始输入 Test ,然后在其子标题(标题2、3 ..., 9),并继续到文档末尾。但是,它仅将文本添加到“标题1”样式的标题中,从而跳过了其子标题。在我看来,只有列表中的第一种样式可以读取。我尝试从列表中删除标题1,并检查标题2样式的标题。

2 个答案:

答案 0 :(得分:1)

以下内容基于我对问题中文档设置的理解,在测试文档中为我工作。

代码需要循环样式。为此,样式必须位于可以循环的内容中- 数组 Split方法基于 定界符 将列表分成数组。分隔符只能是一个字符,因此需要从问题代码中的multiStyles中删除逗号后的空格。

循环时,重要的是要返回每种样式的起点(附录)。为此,下面的代码使用了Range对象。

仅在发现问题后才添加“测试”文本。下面的代码使用布尔变量存储Find.Execute返回的值(如果找到,则返回true),以便可以可靠地测试此值以及Loop Until

查找可能会结束于文档末尾。在这种情况下,代码会陷入无尽的循环,因此需要测试将结束位置移至列表中的下一个样式。

Sub AppendixFix()

    ' Declaring variables
    Dim multiStyles As String, i As Integer
    Dim aStyleList As Variant
    Dim counter As Long, s As String, found As Boolean
    Dim rngStart As Range

    multiStyles = "Heading 1,Heading 2,Heading 3,Heading 4,Heading 5,Heading 6,Heading 7,Heading 8,Heading 9"
    aStyleList = Split(multiStyles, ",")

    ' Start at the top of document and clear find formatting
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting

    ' Navigate to Appendix section
    Selection.Find.style = ActiveDocument.styles("Heading 1")
    With Selection.Find
        .Text = "Appendix"
        .Forward = True
        .wrap = wdFindStop
        .Format = True
        .Execute
    End With
    Selection.HomeKey Unit:=wdLine
    Selection.TypeText Text:=" *Test* "
    Selection.MoveStart wdParagraph, 1
    Set rngStart = Selection.Range.Duplicate

    ' Loop through all the styles in the list
    For counter = LBound(aStyleList) To UBound(aStyleList)
        'Loop as long as the style is found
        Do
            s = aStyleList(counter)
            With Selection.Find
                .style = ActiveDocument.styles(s)
                .Text = "^p"
                .Forward = True
                .wrap = wdFindStop
                .Format = True
                found = .Execute
            End With

            ' Add text to the beginning of each line
            If found Then
                Selection.HomeKey Unit:=wdLine
                Selection.TypeText Text:=" *Test* "
                Selection.MoveStart wdParagraph, 1
            End If
            If Selection.Start = ActiveDocument.content.End - 1 Then
                'End of Document, then loop to next style in list
                Exit For
            End If
        Loop Until found = False
        'start back at the Appendix for the next style
        rngStart.Select
    Next
End Sub

答案 1 :(得分:0)

试一下-我相信这会将测试添加到每个标题的末尾。很难说出您想从问题中做什么。

Sub AppendixFix()

    ' Declaring variables
    Dim multiStyles As Variant, i As Integer
    multiStyles = Array("Heading 1", "Heading 2", "Heading 3", "Heading 4", "Heading 5", "Heading 6", "Heading 7", "Heading 8", "Heading 9")

    ' Start at the top of document and clear find formatting
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting

    ' Navigate to Appendix section
    Selection.Find.Style = ActiveDocument.Styles("Heading 1")
    With Selection.Find
        .Text = "Appendix"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .Execute
    End With

    ' Loop until find is not found and limit to 1000 counts
    Do While Selection.Find.Found = True And i < 1000
        i = i + 1
        ' Add text to the beginning of each line
        Selection.HomeKey Unit:=wdLine
        Selection.TypeText Text:=" *Test* "
        ' Navigate to the next heading by looking at following paragraph mark
        For j = 0 To UBound(multiStyles)
            Selection.Find.Style = ActiveDocument.Styles(multiStyles(j))
            With Selection.Find
                .Text = "^p"
                .Forward = True
                .Wrap = wdFindStop
                .Format = True
                .Execute
                .Execute
            End With
            Selection.TypeText Text:=" *Test* "
        Next j
    Loop

End Sub