Получите информацию о заголовке, используя цикл поиска с подстановочными знаками в MS Word, используя VBA

Например:

Sub GetRefHeadings()
Application.ScreenUpdating = False
Dim Rng As Range, StrOut As String, Tbl As Table
StrOut = "Ref." & vbTab & "Heading" & vbTab & "Page" & vbCr
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "<Reference X[0-9]@>"
    .Replacement.Text = ""
    .Format = False
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
  End With
  Do While .Find.Execute
    Set Rng = .Paragraphs(1).Range
    Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
    StrOut = StrOut & .Text & vbTab & Rng.Paragraphs.First.Range.ListFormat.ListString & _
      " " & Split(Rng.Text, vbCr)(0) & vbTab & Rng.Information(wdActiveEndPageNumber) & vbCr
  Loop
End With
Set Rng = ActiveDocument.Range.Characters.Last
Rng.Text = StrOut
Set Tbl = Rng.ConvertToTable(Separator:=vbTab)
With Tbl
  .PreferredWidthType = wdPreferredWidthPercent
  .PreferredWidth = 100
  .Columns.PreferredWidthType = wdPreferredWidthPercent
  .Columns(1).PreferredWidth = 20
  .Columns(2).PreferredWidth = 70
  .Columns(3).PreferredWidth = 10
  .Rows(1).Range.Font.Bold = True
  .Rows(1).HeadingFormat = True
  '.Sort ExcludeHeader:=True, FieldNumber:=1
End With
Set Rng = Nothing: Set Tbl = Nothing
Application.ScreenUpdating = True
End Sub

Если вам нужна страница # найденного текста, а не страница # заголовка, измените Rng.Information на .Information.

Порядок сортировки по умолчанию определяется по ссылке, независимо от номера ссылки, что совпадает с сортировкой по заголовку. Код также включает закомментированную строку для сортировки по номеру ссылки.

Вы можете найти уровень заголовка раздела текста, который вы нашли, используя предустановленная закладка. Так как этот трюк использует объект Selection, вам нужно передать найденный диапазон текста в Selection. Этот фрагмент кода ниже показывает, как:

Option Explicit

Sub test()
    With ActiveDocument
        Dim foundThis As Range
        Set foundThis = .Range
        With foundThis.Find
            .Text = "<Reference X[0-9]{1,}>"
            .Forward = True
            .MatchWildcards = True
            Do While .Execute
                Dim strFound As String
                Dim heading As String
                strFound = foundThis.Text
                heading = foundThis.GoTo(What:=wdGoToBookmark, _
                                         Name:="\HeadingLevel").Paragraphs(1).Range.Text
                Debug.Print "string found: " & strFound & " on page " & _
                            foundThis.Information(wdActiveEndPageNumber) & _
                            ", Heading: " & heading
            Loop
        End With
    End With
End Sub