Как определить в VBA заголовок в стиле Heading-X чуть выше выделения?

Question

У меня есть документ с многоуровневыми заголовками - оглавление, стили Заголовок 1-n и все такое.Когда я поднимаю панель навигации и перемещаю текстовый курсор внутри документа, панель навигации выделяет заголовок, ближайший к позиции курсора.Разве нет способа получить заголовок в VBA - какое-то свойство объекта Range или Selection?

В модуле класса, в котором есть объект Word-Application WithEvents, я написал обработчик события WindowSelectionChangeчтобы найти «^ p» со стилизованным заголовком 1 или заголовком 2, определите, какой из них ближе, возьмите текст этого заголовка и затем поработайте с ним.Получить текст ближайшего заголовка должно быть проще и быстрее.

Private Sub appWord_WindowSelectionChange(ByVal Sel As Word.Selection)

    Dim lHdrPosn As Long, HP As Long
    Dim sStyle As String
    Dim rngSelPosn As Word.Range
    Dim sHdrText As String
    Dim lRTFposn As Long, lRTFselLength As Long

    With Sel

        If Not (.Document Is ThisDocument) Then Exit Sub

        Set rngSelPosn = .Range
        rngSelPosn.Collapse IIf(.StartIsActive, wdCollapseStart, wdCollapseEnd)

    End With

    With rngSelPosn

        lHdrPosn = -1

        For HP = 2 To 1 Step -1

            sStyle = "Heading " & HP
            With .Find                          ' Find a paragraph mark of style Heading (HP)

                .ClearFormatting
                .Style = sStyle
                .Forward = (Sel.Style = sStyle) ' This is case user clicks in a heading
                                                ' Get the later one
                If .Execute("^p") Then If lHdrPosn = -1 Or rngSelPosn.Start > lHdrPosn Then lHdrPosn = rngSelPosn.Start

            End With

        Next

        If lHdrPosn < 0 Then Exit Sub

    End With

    sHdrText = ThisDocument.Characters(lHdrPosn).Paragraphs(1).Range.Text
    With frmHelpWindow.rtfHelpText              ' Here's the header's text

        lRTFposn = .Find(vbCrLf & sHdrText & vbLf, 0, Len(.TextRTF))
        If lRTFposn < 0 Then Exit Sub

        lRTFselLength = .SelLength

        .SelStart = Len(.TextRTF)

        .SelStart = lRTFposn + 2
        .SelLength = lRTFselLength - 2

        .Refresh

    End With

End Sub

Answer 1

Для этого можно использовать старую закладку WordBasic. Требуется Selection, поэтому позиция курсора в порядке:

Selection.Bookmarks("\HeadingLevel").Range

Чтобы получить ближайший предыдущий абзац заголовка, независимо от уровня:

Selection.Bookmarks("\HeadingLevel").Range.Paragraphs(1)

Чтобы получить текст заголовка (например):

Selection.Bookmarks("\HeadingLevel").Range.Paragraphs(1).Range.Text