title: In MS Word find the Heading under which a table is in the document
body: <p>The folowing VBA problem:</p>
  
  <p>I have a Word document with several chapters ("Heading 1"). At the beginning of the chapters there follows a table with information I want to process. 
  It is easy looping through the "Tables" collection of the document to extract the information in the tables. </p>
  
  <p>But how is it possible, to get the information aka "chapter name" ("Heading 1") unter which theses tables lie? </p>
  
  <p>I need a way to find a "link" from the table in the "Tables"-Collection to the surrounding chapters name ("Heading 1"). So find the chapter  name ("Heading 1") using the information of the "Table"-Objekt in Collection (doc.Tables(1) --> "3. Chaptertitle 3rd chapter")</p>
  
  <p>My idea is to search backwards from the position of the table until I find a range with Style "Heading 1". But how do I get the position information?</p>
  
  <pre><code>    Public Sub ImportRequirementsFromWordTables()
  
      Dim wdDoc As Object
      Dim wdFileName As Variant
      Dim TableNo As Integer 'table number in Word
      Dim iRowWord As Long 'row index in Word
      Dim iRowExcel As Long
      Dim iColWord As Integer 'column index in Excel
      Dim tbl As Variant
      Dim strCurrCell As String
  
  
      wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _
      "Browse for file containing table to be imported")
  
      If wdFileName = False Then Exit Sub '(user cancelled import file browser)
  
      Set wdDoc = GetObject(wdFileName) 'open Word file
  
      'Set Titles in Excel
      Cells(1, 1) = "Anf.-ID"
      Cells(1, 2) = "Referenz"
      Cells(1, 3) = "Anforderungstitel"
      Cells(1, 4) = "System"
      Cells(1, 5) = "Art"
      Cells(1, 6) = "Priorität"
      Cells(1, 7) = "Beschreibung (optional)"
  
  
      With wdDoc
          TableNo = wdDoc.Tables.Count
          For Each tbl In wdDoc.Tables
              'Check if it is a table with Reqs
              If Left$(tbl.Cell(1, 1).Range.Text, 7) = "Anf.-ID" Then
                  'copy cell contents from Word table cells to Excel cells
                  With tbl
                      'Find Chapter Name of chapter table lies in in Word and write to Excel
                      '????
  
                      iRowWord = 2
                      iRowExcel = 2
                      While iRowWord &lt; .Rows.Count
                          For iColWord = 1 To .Columns.Count
                              strCurrCell = .Cell(iRowWord, iColWord).Range.Text
                              Cells(iRowExcel, iColWord) = Mid$(strCurrCell, 1, Len(strCurrCell) - 1)
                          Next iColWord
  
                          'Fill Description
                          strCurrCell = strReplaceSpecialCharacters(.Cell(iRowWord + 1, 3).Range.Text)
                          Cells(iRowExcel, 7) = Mid$(strCurrCell, 1, Len(strCurrCell) - 1)
  
                          'Skip to next relevant in Word aka skip one 
                          iRowWord = iRowWord + 2
                          'Skip to next in Excel
                          iRowExcel = iRowExcel + 1
                      Wend
                  End With
              End If
          Next
      End With
  
      Set wdDoc = Nothing
  
  End Sub
  </code></pre>
  
  <p>I know how to get all Heaadings form document, but I miss how to find chapter for table:</p>
  
  <pre><code>Private Sub getHeading(wdSource As Document)
  
          Dim docSource As Word.Document
          Dim rng As Word.Range
  
          Dim astrHeadings As Variant
          Dim strText As String
          Dim intLevel As Integer
          Dim intItem As Integer
  
          Set docSource = wdSource
  
          ' Content returns only the
          ' main body of the document, not
          ' the headers and footer.
          astrHeadings = _
           docSource.GetCrossReferenceItems(wdRefTypeHeading)
  
          For intItem = LBound(astrHeadings) To UBound(astrHeadings)
              ' Get the text and the level.
              strText = Trim$(astrHeadings(intItem))
              intLevel = GetLevel(CStr(astrHeadings(intItem)))
  
              Debug.Print intLevel &amp; " " &amp; strText
  
          Next intItem
      End Sub
      Private Function GetLevel(strItem As String) As Integer
          ' Return the heading level of a header from the
          ' array returned by Word.
  
          ' The number of leading spaces indicates the
          ' outline level (2 spaces per level: H1 has
          ' 0 spaces, H2 has 2 spaces, H3 has 4 spaces.
  
          Dim strTemp As String
          Dim strOriginal As String
          Dim intDiff As Integer
  
          ' Get rid of all trailing spaces.
          strOriginal = RTrim$(strItem)
  
          ' Trim leading spaces, and then compare with
          ' the original.
          strTemp = LTrim$(strOriginal)
  
          ' Subtract to find the number of
          ' leading spaces in the original string.
          intDiff = Len(strOriginal) - Len(strTemp)
          GetLevel = (intDiff / 2) + 1
      End Function
  </code></pre>
  
  <p>Thanks for any ideas</p>