Find nearest Heading above the MS Word table

Question

I am enumerating tables in Microsoft Word in a following way:

Dim doc As Document, t As Table
Set doc = ActiveDocument
For Each t In doc.Tables
Next t

Now I would like to find the nearest paragraph with "Heading 2" style above the table and get it's text into a variable. Great if it could be accomplished without changing the selection focus in the document.

I can enumerate paragraphs in the document, but how to determine that some paragraph is above some table?

Answer 1

I solved that by building a list of paragraph start positions:

Private Type CaptionRec
  Text As String
  EndPos As Long
End Type

Dim caps() As CaptionRec
Dim i As Long
Dim p As Paragraph
ReDim caps(0)
i = 0
For Each p In doc.Paragraphs
  If p.Style = "Überschrift 2" Then
    i = i + 1
    ReDim Preserve caps(i)
    caps(i).Text = TrimGarbageAtEnd(p.Range.Text)
    caps(i).EndPos = p.Range.Start 'Ok, this should be the end, not the start
  End If
Next p

... and finding the minimum distance between table start and a "Heading 2" paragraph from array:

Public Function GetClosestCaption(tableStart As Long, ByRef caps() As CaptionRec) As String
  Dim cap As CaptionRec, distance As Long, minDistance As Long, res As String, i As Long
  minDistance = 2147483647 'Max long
  res = ""
  For i = LBound(caps) To UBound(caps)
    cap = caps(i)
    distance = tableStart - cap.EndPos
    If distance >= 0 Then
      If distance < minDistance Then
        minDistance = distance
        res = cap.Text
      End If
    End If
  Next i
  GetClosestCaption = res
End Function

The routine gets called in a following loop:

Public Sub MainRoutine()
  For Each t In doc.Tables
    If table_validity_criteria_go_here Then
      caption = GetClosestCaption(t.Range.Start, caps)
      For Each r In t.Rows
        'Enumerate rows
      Next r
    End If
  Next t
End Sub

Answer 2

An alternative is to reverse the logic. Instead of processing the tables and then looking for the associated heading, find the headings then process the tables within the range of the heading level, For example:

Sub FindHeading2Ranges()
   Dim findRange As Range
   Dim headingRange As Range
   Set findRange = ActiveDocument.Content
   With findRange.Find
      .ClearFormatting
      .Forward = True
      .Wrap = wdFindStop
      .Format = True
      .Style = ActiveDocument.Styles(wdStyleHeading2)
      Do While .Execute
         Set headingRange = findRange.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
         If headingRange.Tables.Count > 0 Then
            ProcessTables headingRange, TrimGarbageAtEnd(findRange.text)
         End If
         findRange.Collapse wdCollapseEnd
      Loop
   End With
End Sub

Sub ProcessTables(headingRange As Range, caption As String)
   Dim t As Table
   For Each t In headingRange.Tables
      If table_validity_criteria_go_here Then
         For Each r In t.Rows
            'Enumerate rows
         Next r
      End If
   Next t
End Sub