word VBA中查找指定段落前面最近标题

word VBA中查找指定段落前面最近标题

例如文档结构如下：
标题1
    段落1
    段落2
    标题1.1
        段落3
        标题1.1.1
          段落4

要求指定段落1、2，返回标题1；段落3返回标题1.1；段落4返回标题1.1.1，请问用VBA如何实现？

Sub test()
Dim myRange As Range
Set myRange = Selection.Bookmarks("\headinglevel").Range.Paragraphs(1).Range
MsgBox "编号：" & myRange.ListFormat.ListString & vbCrLf & "标题内容：" & myRange.Text
End Sub

Private Sub CommandButton1_Click()
Call test
End Sub

=========================
VBA如何选中WORD表格中区域（如B3:D6)

在Word中用cell来表示单元格。所以如果按你的要求，要选择表格中的区域B3:D6的话，那么应该是如下代码：
Sub 选择表格中的区域()
    With ActiveDocument
        .Range(.Tables(1).Cell(3, 2).Range.Start, .Tables(1).Cell(6, 4).Range.End).Select
    End With
End Sub

==================================
涉及VBA编程的难题！如何批量提取WORD文档中特定格式的文字？字体属性
也许是说明还不够清楚。可试试如下代码
Sub test()
Dim aPar As Paragraph, n As Integer
Dim textA As String, textB As String, textC As String
Dim myInfo As String
With Selection
    For Each aPar In ActiveDocument.Content.Paragraphs  '对文档各段落内容进行循环提取
        If aPar.Range.Tables.Count > 0 Then Exit For  '遇到表格即退出循环
        n = n + 1
        aPar.Range.Select
        .StartOf wdParagraph
        .SelectCurrentFont
        textA = .Text  '条目内容
        Do While .End < aPar.Range.End - 1
            .Move
            .SelectCurrentFont
        Loop
        textB = ActiveDocument.Range(aPar.Range.Start, IIf(.Font.Italic, .Start, .End)).Text '条目及其解释
        textC = IIf(.Font.Italic, .Text, "")  '例句内容
        myInfo = myInfo & n & vbTab & textA & vbTab & textB & vbTab & textC & vbCrLf
    Next
    Documents.Add.Content = myInfo  '新文档输出提取结果，以制表符分隔三项内容
End With
End Sub
====================================================================