如何扩展Word VBA范围返回的范围.查找直到段落末尾

Question

我有大量的单词文本，其行应该是 Heading3，但实际上是以 *** 开头的简单文本

前任。

*** Day 1

第1天发生了一些事情......等等

*** Day 2

第2天发生了一些事情......等等

我正在尝试选择这些行，删除 3 星单词，并将该行作为标题 3。

我也避免(最佳实践？(在vba中使用选择对象，而是专注于range.find方法。我可以很容易地找到***字，但是如何扩展到行尾呢？事实上，range.find 没有扩展方法。所以我诉诸于使用通配符...我没有成功。

目前，我没有开始代码的格式化过程，因为我没有设法通过查找过程。

Sub FindAndReplace3Stars()
Dim myStoryRange As Range   
For Each myStoryRange In ActiveDocument.StoryRanges
With myStoryRange.Find
.Text = "<***>*^13"
.Replacement.Text = "B"
.MatchWildcards = True 
.Wrap = wdFindContinue 
.Execute Replace:=wdReplaceAll
End With
Next myStoryRange
End Sub

Answer 1

从理论上讲，可以找到一些东西，指定段落样式作为替换的一部分，它应该影响整个段落。但是，当要应用的样式是"链接样式"时，这会产生问题：一种既可以作为段落应用也可以作为字符样式应用的样式。不幸的是，所有内置标题样式都是这种情况。应用此类样式不一定会更改段落中文本字符的格式 - 直接格式可能会覆盖，以便在使用样式设置段落格式时，文本在视觉上可能看起来不同。

因此，简单的查找/替换是不够的，因为需要额外的步骤来强制正确的格式。

以下内容对我有用。

我认为应该删除星号，因此将替换文本设置为空字符串。在这种情况下，通配符不是必需的。

执行是在Do...Loop中执行的，以便单独找到术语的每个实例并进行替换。然后应用样式并选择范围以使用ClearCharacterDirectFormatting方法。这相当于以用户身份按 Ctrl+空格键，并强制所选内容显示段落样式的格式，该格式可能已被直接字体格式覆盖。

然后，有必要在继续查找之前折叠Range。

Sub FindAndReplace3Stars()
Dim myStoryRange As Range
Dim sFindTerm As String
sFindTerm = "***"
For Each myStoryRange In ActiveDocument.StoryRanges
With myStoryRange.Find
.Text = sFindTerm
.Replacement.Text = ""
.wrap = wdFindStop
Do While .Execute(Replace:=wdReplaceOne)
myStoryRange.style = wdStyleHeading3
myStoryRange.Select
With Selection
.ClearCharacterDirectFormatting
End With
myStoryRange.Collapse wdCollapseEnd
Loop
End With
Next myStoryRange
End Sub

或者，基于问题中使用通配符的原始方法并选择整个段落(而不是句子(可能类似于以下代码示例。在这种情况下，搜索文本分为两个"表达式"：星号和段落的其余部分。替换文本是第二个表达式(@- 段落的其余部分(，在这种情况下，样式作为替换的一部分应用。

仍然需要选择并清除直接格式，以确保样式格式可见。

Sub FindAndReplace3Stars_Alternate()
Dim myStoryRange As Range
Dim sFindTerm As String
sFindTerm = "(***)(?*^013)"
For Each myStoryRange In ActiveDocument.StoryRanges
With myStoryRange.Find
.Text = sFindTerm
.Replacement.Text = "2"
.Replacement.style = wdStyleHeading3
.MatchWildcards = True
.wrap = wdFindStop
Do While .Execute(Replace:=wdReplaceOne)
myStoryRange.Select
With Selection
.ClearCharacterDirectFormatting
End With
myStoryRange.Collapse wdCollapseEnd
Loop
End With
Next myStoryRange
End Sub

Answer 2

大概您的文本仅在文档正文中，在这种情况下 - 除非有直接格式 - 您可以将代码简化为：

Sub FindAndReplace3Stars()
Application.ScreenUpdating = False
With ActiveDocument.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[*]{3}[ ]{1,}(*^13)"
.Replacement.Text = "1"
.Replacement.Style = wdStyleHeading3
.MatchWildcards = True
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
End Sub

如果要处理多个故事范围，则可以使用：

Sub FindAndReplace3Stars()
Application.ScreenUpdating = False
Dim Rng As Range
For Each Rng In ActiveDocument.StoryRanges
With Rng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = False
.Forward = True
.Text = "[*]{3}[ ]{1,}(*^13)"
.Replacement.Text = "1"
.Replacement.Style = wdStyleHeading3
.MatchWildcards = True
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Next
Application.ScreenUpdating = True
End Sub

最后，如果存在直接格式设置，则可以在不使用选择的情况下更有效地删除该格式。例如：

Sub FindAndReplace3Stars()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[*]{3}*^13"
.MatchWildcards = True
.Wrap = wdFindStop
.Execute
End With
Do While .Find.Found = True
.Style = wdStyleHeading3
.Text = Trim(Split(.Text, "***")(1))
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
End Sub

并且，要处理所有故事范围：

Sub FindAndReplace3Stars()
Application.ScreenUpdating = False
Dim Rng As Range
For Each Rng In ActiveDocument.StoryRanges
With Rng
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[*]{3}*^13"
.Replacement.Text = ""
.MatchWildcards = True
.Wrap = wdFindStop
.Execute
End With
Do While .Find.Found = True
.Style = wdStyleHeading3
.Text = Trim(Split(.Text, "***")(1))
.Find.Execute
Loop
End With
Next
Application.ScreenUpdating = True
End Sub