Word 2016 VBA循环，直到文档结束

Question

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

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

我正在尝试在新节开始之前插入一个连续的分节符，我将其指定为使用样式标题 1 格式化的文本。我完全愿意以另一种方式做到这一点，并感谢您的见解！

Sub InsertSectionBreak()
' Go to start of document
Selection.HomeKey Unit:=wdStory
' Find next section based on header formatting, insert continuous section break just before
'
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Heading 1")
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Do While Selection.Find.Execute = True
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.InsertBreak Type:=wdSectionBreakContinuous
Loop
End Sub

Answer 1

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

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

下面的代码示例使用Range对象而不是Selection。您可以将范围视为具有非常重要的区别的不可见选择：可以有多个范围;只能有一个选择。

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

如果查找成功，则找到的区域将复制到分节符的范围。Duplicate制作原始范围的独立"副本"，以便可以彼此独立地操作它们。然后将分节符的范围折叠到其起点(可以想象为按左箭头(，然后插入分节符。

但是，"查找"范围将折叠到其终点，以便将其移动到使用标题 1 设置格式的文本之外，以便可以定位下一个标题 1。然后再次执行 find，循环重复，直到找不到标题 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

请注意，此方法获取与最近标题关联的所有内容，而不考虑其级别;可以使用更复杂的方法来获取与特定标题级别关联的所有内容，以便在子标题下找到匹配项时，将使用前面的主要标题来确定跨越的范围。