VBA 查找标题、删除并移至下一个标题

Question

我有以下代码来查找标题中包含“DELETE”一词的标题（从标题 1-4 不等），以删除标题及其下方的文本，以及嵌套的标题。但是，它会在删除找到的第一组标题后停止。我怎样才能让它处理文档中的所有标题？谢谢！

Sub deleteheading()
  Dim rngHeading1 As Range
  Set rngHeading1 = GetHeadingBlock("DELETE", wdStyleHeading1)
  If Not rngHeading1 Is Nothing Then rngHeading1.Delete
  
    Dim rngHeading2 As Range
  Set rngHeading2 = GetHeadingBlock("DELETE", wdStyleHeading2)
  If Not rngHeading2 Is Nothing Then rngHeading2.Delete
  
    Dim rngHeading3 As Range
  Set rngHeading3 = GetHeadingBlock("DELETE", wdStyleHeading3)
  If Not rngHeading3 Is Nothing Then rngHeading3.Delete
  
    Dim rngHeading4 As Range
  Set rngHeading4 = GetHeadingBlock("DELETE", wdStyleHeading4)
  If Not rngHeading4 Is Nothing Then rngHeading4.Delete

End Sub
Function GetHeadingBlock(headingText As String, headingStyle As WdBuiltinStyle) As Range
  Dim rngFind As Range
  Set rngFind = ActiveDocument.Content
  With rngFind.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "DELETE"
    .style = headingStyle
    .Replacement.Text = ""
    .Forward = True
    .Format = True
    .Wrap = wdFindStop
    If .Execute Then Set GetHeadingBlock = _
      rngFind.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
  End With
End Function

Answer 1

例如：

Sub DeleteHeadingSpanText()
Application.ScreenUpdating = False
Dim h As Long
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "DELETE"
    .Replacement.Text = ""
    .Format = True
    .Forward = True
    .MatchCase = True
    .MatchWholeWord = True
    .Wrap = wdFindContinue
  End With
  For h = 1 To 9
    .Style = "Heading " & h
    Do While .Find.Execute
      .Duplicate.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel").Text = vbNullString
    Loop
  Next
End With
Set RngHd = Nothing
Application.ScreenUpdating = True
End Sub

更改 'For h = 1 To 9' 中的 1 和 9 以定义要将代码范围限制到的任何标题级别。

Answer 2

此代码调用您自己的函数GetHeadingBlock。

Sub DeleteHeading()

  Dim rngHeading    As Range
  Dim i             As WdBuiltinStyle
  
  For i = wdStyleHeading1 To wdStyleHeading4 Step -1
    Do
      Set rngHeading = GetHeadingBlock("DELETE", i)
      If rngHeading Is Nothing Then
          Exit Do
      Else
          rngHeading.Delete
      End If
    Loop
  Next i
End Sub

VBA 查找标题、删除并移至下一个标题

VBA to find heading, delete, and move onto next heading

vba

ms-word