在多个条件下检索段落文本 Word VBA

Retrieving paragraph text in multiple conditions Word VBA

在一个长的 Word 文档中,我想执行以下操作:

找到所有 'Heading 2' 样式的段落,如果这些标题不是“注释”,则将某种样式应用到紧接着的段落。

这是我的代码:

Dim oPara As Paragraph
    For Each oPara In ActiveDocument.Paragraphs
        If oPara.Style = "Heading 2" And oPara.Range.Text <> "Notes" Then
            oPara.Range.Next(Unit:=wdParagraph, Count:=1).Select
           Selection.Style = "Normal"
        End If
    Next oPara

但是,带有“注释”字样的段落并未排除在程序之外,因此跟随它们的段落也会转换为“正常”样式。我什至不确定 oPara.Range.Text 是否真的检索到该段落的措辞。

谢谢。

这样试试:

Dim oPara As Paragraph

For Each oPara In ActiveDocument.Paragraphs
    If oPara.Style = "Heading 2" And Replace(oPara.Range.Text, Chr(13), "") <> "Notes" Then
        oPara.Range.Next(Unit:=wdParagraph, Count:=1).Select
       Selection.Style = "Normal"
    End If
Next oPara

Word似乎在页眉文本后包含一个回车return Chr(13),所以在检查页眉文本是否为"Notes"时,回车return必须是已删除。

查找 'Heading 2' 的所有实例的最有效方法是使用 Find。然后,您可以测试找到的范围内的文本,如果它符合您的条件,则将样式应用于以下段落。

Sub FormatAfterHeading()
   Dim findRange As Range
   Set findRange = ActiveDocument.Content
   With findRange.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = ""
      .Style = ActiveDocument.Styles(wdStyleHeading2)
      .Forward = True
      .Format = True
      .Wrap = wdFindStop
      Do While .Execute = True
         If InStr(findRange.Text, "Notes") > 0 Then
            'do nothing
         Else
            findRange.Next(wdParagraph, 1).Style = wdStyleNormal
         End If
         findRange.Collapse wdCollapseEnd
      Loop
   End With
End Sub

我同意蒂莫西的观点。以下速度更快 - 更简单。它也更可靠,因为 Timothy 的代码匹配段落中任何地方的 'Notes' 而不是 'Notes' 是整个段落文本。

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = ""
    .Style = ActiveDocument.Styles(wdStyleHeading2)
    .Forward = True
    .Format = True
    .Wrap = wdFindStop
  End With
  Do While .Find.Execute = True
    If .Text <> "Notes" & vbCr Then .Next(wdParagraph, 1).Style = wdStyleNormal
    .Collapse wdCollapseEnd
  Loop
End With
Application.ScreenUpdating = True
End Sub