Determine current heading text and number for a Word comment

Question

Context: Microsoft Word programming via VBA or VSTO.

The Comments property of a Word Document object allows enumerating over all comments in a Word document.

How can you find the current heading for a Word comment?

Example document:

Heading 1

Heading 1.1

(commment A)

Output: comment A - Heading 1.1

Answer 1

I couldn't find easier way of doing it but it's working. The following code is searching for last heading before first comment in active document. You can easily adopt it for all comments using For Each loop.

Sub Heading_Above_Comment()

    Dim COMM As Comment
    Set COMM = ActiveDocument.Comments(1)

    'set new selection for range to search
    Dim rngWHERE As Range
    Set rngWHERE = ActiveDocument.Range(0, COMM.Reference.Start)
    rngWHERE.Select

    Selection.Find.ClearFormatting

    'set heading style name you applied>>
    Selection.Find.Style = ActiveDocument.Styles("Nagłówek 1")

    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = False
        .Wrap = wdFindContinue
        .Format = True
    End With

    Do While Selection.Find.Execute
        If Selection.End < COMM.Reference.Start And _
            Selection.Start > rngWHERE.Start Then
            Set rngWHERE = Selection.Range
        Else
            Exit Do
        End If
    Loop

    'select the range
    rngWHERE.Select
    'range selected is last heading
    MsgBox "last heading befor comment is selected and it is: " & Selection.Text
End Sub

How it works:

Answer 2

Reference.GoTo will take you to the current heading (if there is one).
(See also: Text of the preceding heading in word)

Dim COMM As Comment
Set COMM = ActiveDocument.Comments(1)

Dim heading As Range
Set heading = COMM.Reference.GoTo(What:=wdGoToHeading, Which:=wdGoToPrevious)

' Get heading numbering string
Dim hNum$
hNum$ = heading.ListFormat.ListString

' Get heading text
Dim hText$
' Expand the range to the whole paragraph (final CR included)
heading.Expand Unit:=wdSentence
hText$ = heading.Text

MsgBox hNum$ & vbTab & """" & Left(hText$, Len(hText$) - 1) & """"

Now if you want the whole level:

Dim headingLevel As Range
' headingLevel encompasses the region under the heading preceding COMM
Set headingLevel = COMM.Reference.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")