问选择/删除基于用户表单的标题和内容复选框

EN

Sub DeleteHeadingSpanText(StrTxt As String, h As Long)
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = StrTxt
    .Style = "Heading " & h
    .Replacement.Text = ""
    .Format = True
    .Forward = True
    .Wrap = wdFindContinue
    .Execute
  End With
  If .Find.Found = True Then
    .Duplicate.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel").Delete
  End If
End With
End Sub

Sub Demo()
Call DeleteHeadingSpanText("ipsum dolor", 1)
End Sub

Public Sub ComOK_Click()

'Warning msgbox confirm sections being deleted
Dim answer As Integer
Dim strResult As String
Dim strDelete As String
Dim obj As Object

strResult = "You are about to remove the following templates from this document:" & vbCr

For Each obj In Me.Controls
    Select Case TypeName(obj)
        Case "CheckBox"
            If obj.Value = True Then
                strResult = strResult & vbCr & obj.Caption
            End If
    End Select
Next obj

answer = MsgBox(strResult & vbCr & vbCr & "THIS CANNOT BE UNDONE after saving your document." 
& vbCr & "Do you want to continue?", vbOKCancel, "WARNING")

If answer = vbOK Then

UserFormSections.Hide
Application.ScreenUpdating = False

'Delete sections from document
For Each obj In Me.Controls
    Select Case TypeName(obj)
        Case "CheckBox"
            If obj.Value = True Then
                strDelete = obj.Caption
                    Call DeleteHeading(strDelete)
            End If
    End Select
Next obj
Else
End If

'Expand remaining headings
With ActiveDocument.ActiveWindow.View
    .ExpandAllHeadings
End With
'land back on titlepage after sub
ActiveDocument.Bookmarks("DeleteTemplate").Select

Application.ScreenUpdating = True

'Confirm delete to user
MsgBox "Your selected section(s) have been deleted.", vbOKOnly, "Deleted"
End Sub

Sub DeleteHeading(strText As String)
Dim HeadingF As Range
Set HeadingF = ActiveDocument.Content

'Search for match
    With HeadingF.Find
        .Style = "Heading 2"
        .Text = strText
        .Forward = True
        .Wrap = wdFindStop
        .MatchWholeWord = True
        .MatchCase = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchAllWordForms = False
        .Execute
    End With
'Delete match
    If HeadingF.Find.Found Then
        HeadingF.Select
        Selection.MoveEnd wdParagraph
        Selection.Delete
    End If
End Sub```