Question

我在线上查看了许多不同的答案，但无法找到适合我的代码的解决方案。这是我第一次用Word编写VBA（对Excel有一定的经验）。

我认为this post可能是我所需要的，但是它并没有为我停止文档末尾的循环。

我正在尝试在新节开始之前插入一个连续的分节符，我将其指定为采用标题1格式设置的文本。我完全愿意以另一种方式进行此操作，感谢您见解！

row_number()

Answer 1

问题中的代码还不错，但是有一个主要问题：Selection正在移向文档的开头，以便插入分节符。这意味着下次Find再次运行时，它会找到相同的标题1，从而在同一位置重复插入分节符。

另一个问题是代码正在执行Find作为Do While标准的一部分（这就是为什么它没有在文档中找到标题1的第一个实例）的原因。

以下代码示例适用于Range对象而不是Selection对象。您可以将范围视为无形选择，但有非常重要的区别：可以有多个范围；只能有一个选择。

建议的代码使用两个范围：一个用于“查找”，另一个用于插入分节符。查找范围设置为整个文档。查找是否成功存储在布尔变量（bFound）中。

如果查找成功，则找到的范围将复制到分节符的范围。 Duplicate对原始范围进行独立的“复制”，以便可以彼此独立地进行操作。然后将分节符的范围缩小到起点（可以像按向左箭头那样思考），然后插入分节符。

但是，将“查找”范围折叠到其终点，以便将其移动到使用标题1设置格式的文本之外，从而可以定位下一个标题1。然后再次执行查找，并重复循环，直到找不到标题1的更多实例为止。

Sub InsertSectionBreak()
    Dim rngFind As Word.Range, rngSection As Word.Range
    Dim bFound As Boolean

    Set rngFind = ActiveDocument.content

    ' Find next section based on header formatting, insert continuous section break just before
    '
    rngFind.Find.ClearFormatting
    rngFind.Find.style = ActiveDocument.styles("Heading 1")
    With rngFind.Find
        .text = ""
        .Replacement.text = ""
        .Forward = True
        .wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        bFound = .Execute
    End With

    Do While bFound
        Set rngSection = rngFind.Duplicate
        rngSection.Collapse wdCollapseStart
        rngSection.InsertBreak Type:=wdSectionBreakContinuous
        rngFind.Collapse wdCollapseEnd
        bFound = rngFind.Find.Execute
    Loop
End Sub

Answer 2

如果您感兴趣的内容与标题相关，则无需分节符即可获取该标题下的所有内容。例如：

Sub GetHeadingSpanText()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = InputBox("What is the text to find?")
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  If .Find.Found = True Then
    Set Rng = .Paragraphs(1).Range
    Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
    MsgBox Rng.Text
  End If
End With
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

请注意，此方法获取与最近标题相关的所有内容，而不论其级别如何；可以使用一种更复杂的方法来获取与特定标题级别相关的所有内容，这样，如果在子标题下找到匹配项，则使用先前的主要标题来确定范围。

Word 2016 VBA循环直到文档结尾

2 个答案: