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

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

前

第一天发生了什么事。。。等

*** Day 2

第二天发生了什么事。。。等

我正在尝试选择这些行，删除三星单词，并将该行设置为heading3

我还避免（最佳实践？）在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

Sub FindAndReplace3Stars（）
暗myStoryRange作为范围
对于ActiveDocument.StoryRanges中的每个myStoryRange
使用myStoryRange。查找
.Text=“*^13”
.Replacement.Text=“B”
.MatchWildcards=True
.Wrap=wdFindContinue
.Execute Replace:=wdReplaceAll
以
下一个myStoryRange
端接头

理论上，可以找到一些东西，指定一个段落样式作为替换的一部分，它应该会影响整个段落。但是，如果要应用的样式是“链接样式”：既可以作为段落样式也可以作为字符样式应用的样式，则会出现问题。不幸的是，所有内置标题样式都是如此。应用这种样式不一定会更改段落中文本字符的格式-直接格式可能会覆盖，这样，当段落使用样式进行格式设置时，文本在视觉上可能会有所不同

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

以下内容适合我

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

执行是在

Do…循环中进行的

，这样就可以单独找到术语的每个实例并进行替换。然后应用样式并选择范围，以便使用

ClearCharacterDirectFormatting

方法。这相当于用户按Ctrl+空格键，并强制选择显示可能已被直接字体格式覆盖的段落样式格式

在继续查找之前，需要折叠

范围

   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

假定您的文本仅在文档正文中，在这种情况下，除非有直接格式，否则您可以将代码缩减为：

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

非常感谢你。这很有效，解释也很好。然而，我真的希望通过知道hot可以选择这样的句子来增加我使用通配符的知识…@ZiadElHachem查看我的编辑。然而，您最初的示例并没有选择一个句子-它指定了一个段落（ANSI 13）。如果你真的想要一个句子，就用一个。（句号）而不是ANSI 13…请记住，VBA和Word的通配符语法都不允许匹配，以确保返回的结果是语法句子。例如，将一个范围扩展到下一个期间可以很容易地在用作缩写的任何期间停止，例如在Mr.，Mrs.，例如，i.e.，等中。
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