Word VBA 列表框删除文档中的某些部分不删除

Question

这个 Userform VBA 宏的目标是循环遍历文档，捕获使用“Header 1”、“Heading 2”和“Heading 3”样式的标题编号和文本，并为用户提供从中删除这些部分的选项文件。有包括一个部分、排除一个部分、包括所有部分和排除所有部分的切换。

我的问题是，当我排除某些部分时，它不会排除这些部分。我的目标是让它删除该部分并删除该部分中的任何多级（例如，如果我排除第 1.4 节，那么第 1.4.1 节和 1.4.2 节也会被删除。

任何帮助将不胜感激 - 我想知道我做错了什么。

Sub Cancel_Click()
Unload Me
End Sub


Private Sub OkButton_Click()
    Dim i As Integer
    Dim j As Integer
    Dim excluded As Boolean
    
    For i = 1 To ActiveDocument.Sections.Count
        excluded = True
        For j = 0 To Me.ListBox1.ListCount - 1
            If Me.ListBox1.List(j, 0) = "Include" And Me.ListBox1.List(j, 1) = i Then
                excluded = False
                Exit For
            End If
        Next j
        
        If excluded Then
            Dim para As Paragraph
            Dim headingLevel As Integer
            For Each para In ActiveDocument.Sections(i).Range.Paragraphs
                If para.style = "Heading 1" Or para.style = "Header 2" Or para.style = "Header 3" Then
                    headingLevel = para.OutlineLevel
                    If headingLevel = wdOutlineLevel1 Or headingLevel = wdOutlineLevelBodyText Then
                        para.Range.Delete
                    ElseIf headingLevel = wdOutlineLevel2 Then
                        Dim nextPara As Paragraph
                        Set nextPara = para.Next
                        Do While nextPara.OutlineLevel >= wdOutlineLevel3
                            nextPara.Range.Delete
                            Set nextPara = nextPara.Next
                        Loop
                        para.Range.Delete
                    ElseIf headingLevel = wdOutlineLevel3 Then
                        para.Range.Delete
                    End If
                End If
            Next para
        End If
    Next i
    
    Unload Me
End Sub






Function IsSelected(index As Integer) As Boolean
    Dim i As Integer

For i = 0 To Me.ListBox1.ListCount - 1
    If Me.ListBox1.Selected(i) And i + 1 = index Then
    IsSelected = True
Exit Function
End If
Next i
End Function

Sub UserForm_Initialize()
Dim para As Paragraph
Dim num As String
Me.ListBox1.ColumnWidths = "40pt;40pt;250pt"
For Each para In ActiveDocument.Paragraphs
If para.style = "Heading 1" Or para.style = "Header 2" Or para.style = "Header 3" Then
num = para.Range.ListFormat.ListString
If para.style = "Header 2" Then
    Me.ListBox1.AddItem ""
    Me.ListBox1.List(Me.ListBox1.ListCount - 1, 0) = "Include"
    Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = num
    Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = Left(para.Range.Text, Len(para.Range.Text) - 1)
ElseIf para.style = "Header 3" Then
    Me.ListBox1.AddItem ""
    Me.ListBox1.List(Me.ListBox1.ListCount - 1, 0) = "Include"
    Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = num
    Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = Left(para.Range.Text, Len(para.Range.Text) - 1)

Else
    Me.ListBox1.AddItem ""
    Me.ListBox1.List(Me.ListBox1.ListCount - 1, 0) = "Include"
    Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = num
    Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = Left(para.Range.Text, Len(para.Range.Text) - 1)
End If
End If
Next para
End Sub

Sub IncludeSection_Click()
Dim i As Integer
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
ListBox1.List(i, 0) = "Include"
End If
Next i
End Sub

Sub ExcludeSection_Click()
Dim i As Integer
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
ListBox1.List(i, 0) = ""


End If
Next i
End Sub

Private Sub ExcludeAll_Click()
    Dim i As Long
    For i = 0 To ListBox1.ListCount - 1
        ListBox1.List(i, 0) = ""
        ListBox1.Selected(i) = False
    Next i
End Sub

Private Sub IncludeAll_Click()
    Dim i As Long
    For i = 0 To ListBox1.ListCount - 1
        ListBox1.List(i, 0) = "Included"
        ListBox1.Selected(i) = False
    Next i
End Sub

我尝试选择所有部分并排除它们 - 当我这样做时它会删除所有内容。