How to determine in VBA the Heading-X styled heading just above the selection?

Question

I have a document with multi-level headings -- table of contents, styles Heading 1-n, all that. When I pull up the Navigation Pane and move the text cursor within the document, the Navigation Pane highlights the heading closest to the cursor position. Isn't there some way get what that heading is in VBA -- some property of the Range or Selection object?

In a class module that has a Word-Application object WithEvents I've written a WindowSelectionChange event handler to search for "^p" with styled Heading 1 or Heading 2, determine which one is closer, get that heading's text and then do stuff with it. It should be simpler and faster to get the nearest heading's text.

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

Cross-posted and answered at: excelforum.com/word-formatting-and-general/…. For cross-posting etiquette, please read: excelguru.ca/content.php?184 — macropod

Cindy Meister Cindy Meister · Accepted Answer · 2019-04-20T14:18:42

There's an old WordBasic bookmark that can be used for this. It requires Selection, so the cursor position is fine:

Selection.Bookmarks("\HeadingLevel").Range

To get the closest, previous heading paragraph, no matter which level:

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

To get the text of the heading (for example):

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

How to determine in VBA the Heading-X styled heading just above the selection?

1 Answers