如何获取Word VBA中标题1之后的列表？

Question

以下显示了很长文档的模式：

<heading1>
<numberedlist>
<heading2>
<numberedlist>
<heading3>
<numberedlist>

当我使用Document.Lists时，我会获得文档中的所有列表。当Document.Paragraphs使用Document.Paragraphs(i).Style = "Heading 1"进行迭代时，我会得到所有标题。

但我想要的是紧接在“标题1”之后的列表（不是列表中的段落）

Answer 1

假设您的文档看起来像下图所示：

使用此建议代码，您可以选择第一个列表（标题后立即）和位于标题下方的其他类似列表但不是第二个（标题和列表之间还有其他段落 - 对于该情况，请参阅代码中的其他注释）

Sub List_after_Heading()

    Dim rngLIST As Range
    Set rngLIST = ActiveDocument.Content

    With rngLIST.Find
        .Style = "Heading 1"   '<--change into your Heading name
        .Forward = True
        .Wrap = wdFindStop
    End With

    Do
        rngLIST.Find.Execute
        If rngLIST.Find.Found Then

            'I assume that list start in NEXT paragraph, if not, it wouldn't be found
            'or you need to change part of line into .Next.Next paragraphs,
            'alternatively some looping would be needed here

            'we check if paragraph next to Heading contains a list
            If rngLIST.Paragraphs(1).Next.Range.ListParagraphs.Count > 0 Then
                'we have the list, but it's not easy to select at once
                Dim iLIST As List
                For Each iLIST In ActiveDocument.Lists
                    If iLIST.Range.Start = rngLIST.Paragraphs(1).Next.Range.Start Then
                        'here we have it... selected
                        iLIST.Range.Select

                        'or any other of your code here
                    End If
                Next
            End If
        End If
    Loop While rngLIST.Find.Found

End Sub

Answer 2

我使用书签来标识标题，然后简单地在它们之间返回文本。但我不确定But What I want is the List (not paragraph of the list)

的含义

<强>截图

<强>代码

Option Explicit

Sub Sample()
    Dim MyRange As Range

    Selection.HomeKey Unit:=wdStory

    On Error Resume Next
    ActiveDocument.Bookmarks("MYStartBookMark").Delete
    ActiveDocument.Bookmarks("MYEndBookMark").Delete
    On Error GoTo 0

    '~~> Find Heading 1
    With Selection.Find
        .ClearFormatting
        .Style = ActiveDocument.Styles("Heading 1")
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .Execute
    End With

    '~~> Move one space to the right
    Selection.MoveRight Unit:=wdCharacter, Count:=1

    '~~> Insert the start Book mark
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="MYStartBookMark"
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    End With

    '~~> Find Heading 2
    With Selection.Find
        .ClearFormatting
        .Style = ActiveDocument.Styles("Heading 2")
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .Execute
    End With

    '~~> Move one space to the left
    Selection.MoveLeft Unit:=wdCharacter, Count:=1

    '~~> Insert the end Book mark
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="MYEndBookMark"
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    End With

    '~~> Identify the range between the Start BookMark and End BookMark
    Set MyRange = ActiveDocument.Range
    MyRange.Start = MyRange.Bookmarks("MYStartBookMark").Range.End
    MyRange.End = MyRange.Bookmarks("MYEndBookMark").Range.Start

    '~~> This gives you that text
    Debug.Print MyRange.Text

    '~~> Delete the BookMarks
    On Error Resume Next
    ActiveDocument.Bookmarks("MYStartBookMark").Delete
    ActiveDocument.Bookmarks("MYEndBookMark").Delete
    On Error GoTo 0
End Sub

<强>结果

其他测试

有人可能会说，如果我们不知道下一个标题是什么呢？这是一个公平的观点，因为我们可以有两个场景。让我一起掩盖他们

1. 在标题1之后，我们有标题3
2. 文件中的最后一个标题是标题1，之后没有标题。

修改后的代码

Option Explicit

Sub Sample()
    Dim MyRange As Range
    Dim MyArray
    Dim strOriginal As String, strTemp As String
    Dim numDiff As Long, i As Long, NextHd As Long
    Dim NoNextHeading As Boolean

    Selection.HomeKey Unit:=wdStory

    On Error Resume Next
    ActiveDocument.Bookmarks("MYStartBookMark").Delete
    ActiveDocument.Bookmarks("MYEndBookMark").Delete
    On Error GoTo 0

    '~~> Get all the headings in the array
    NoNextHeading = True

    For i = LBound(MyArray) To UBound(MyArray)
        strOriginal = RTrim$(MyArray(i))
        strTemp = LTrim$(strOriginal)
        numDiff = Len(strOriginal) - Len(strTemp)
        numDiff = (numDiff / 2) + 1
        '~~> If heading one is found and it is not the last heading
        '~~> in the array then find what is the next heading
        If numDiff = 1 And i <> UBound(MyArray) Then
            strOriginal = RTrim$(MyArray(i + 1))
            strTemp = LTrim$(strOriginal)
            numDiff = Len(strOriginal) - Len(strTemp)
            numDiff = (numDiff / 2) + 1
            NextHd = numDiff
            NoNextHeading = False
            Exit For
        End If
    Next i

    '~~> Find Heading 1
    With Selection.Find
        .ClearFormatting
        .Style = ActiveDocument.Styles("Heading 1")
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .Execute
    End With

    '~~> Move one space to the right
    Selection.MoveRight Unit:=wdCharacter, Count:=1

    '~~> Insert the start Book mark
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="MYStartBookMark"
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    End With

    If NoNextHeading = False Then
        '~~> Find Heading NextHd
        With Selection.Find
            .ClearFormatting
            .Style = ActiveDocument.Styles("Heading " & NextHd)
            .Text = ""
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .Execute
        End With

        '~~> Move one space to the left
        Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Else
        '~~> Move to the end of the document
        ActiveDocument.Characters.Last.Select
        Selection.Collapse
    End If

    '~~> Insert the end Book mark
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="MYEndBookMark"
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    End With

    '~~> Identify the range between the Start Book Mark and End BookMark
    Set MyRange = ActiveDocument.Range
    MyRange.Start = MyRange.Bookmarks("MYStartBookMark").Range.End
    MyRange.End = MyRange.Bookmarks("MYEndBookMark").Range.Start

    '~~> This give you that text
    Debug.Print MyRange.Text

    '~~> Delete the BookMarks
    On Error Resume Next
    ActiveDocument.Bookmarks("MYStartBookMark").Delete
    ActiveDocument.Bookmarks("MYEndBookMark").Delete
    On Error GoTo 0
End Sub