Generating automatic caption for table based on document section

[afif]

I'm wondering whether it's possible to use VBA to generate automatic table caption based on the section where the table is in (for example there is a document about sales of any kind of vehicle. chapter 3 contains information about car (so the heading is like chapter 3. Car ). Inside this chapter, there is a table about car sales. The caption of the table is generated by reading the heading/the title of the section).

I'm trying to put automatic caption on tens of tables in a document. It is not that good if the caption only contains the table number (Table 1, Table 2, etc) without any other information.
Thanks in advance.

[gmaxey]

What you are describing are not "sections." Provided your "Chapter 3. Car" is a paragraph with an outline level 1 e.g., Heading1. Then the following may work:

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oTbl As Table
Dim oRng As Range, oRngCap As Range
Dim strTitle As String
  For Each oTbl In ActiveDocument.Tables
    Set oRng = oTbl.Range
    Set oRngCap = oTbl.Range
    oRng.Collapse wdCollapseStart
    oRngCap.Collapse wdCollapseEnd
    Do
      oRng.MoveStart wdParagraph, -1
      oRng.End = oRng.Paragraphs(1).Range.End - 1
      strTitle = oRng.Text
    Loop Until oRng.Paragraphs(1).OutlineLevel = 1
    oRngCap.InsertCaption Label:="Table", TitleAutoText:="", Title:=" - " & strTitle, _
    Position:=wdCaptionPositionAbove, ExcludeLabel:=0
  Next
lbl_Exit:
  Exit Sub
End Sub

[Guessed]

Greg's code always gives you the above Heading 1 text. If you wanted the nearest preceding heading of any level the code could be

Sub ScratchMacro()
  Dim oTbl As Table, oRng As Range, rngHead As Range, strTitle As String
  For Each oTbl In ActiveDocument.Tables
    Set oRng = oTbl.Range
    Set rngHead = oRng.GoTo(What:=wdGoToHeading, Which:=wdGoToPrevious, Count:=1).Paragraphs(1).Range
    rngHead.MoveEnd Unit:=wdCharacter, Count:=-1
    strTitle = rngHead.Text
    oTbl.Range.InsertCaption Label:="Table", Title:=" - " & strTitle, Position:=wdCaptionPositionAbove, ExcludeLabel:=0
  Next
End Sub

[afif]

Thanks Greg, Andrew..
Both codes work like a charm..

[gmaxey]

Actually Andrew's code is cleaner ;-). If you really do only want to use a specific heading to fix the table captions (e.g., Heading 1), here is a version which combines his method and mine:

Sub ScratchMacro()
Dim oTbl As Table, oRngHeading As Range
Dim lngLevel As Long
  lngLevel = 1 'This means only Heading 1 Style is used to define table titles.
  For Each oTbl In ActiveDocument.Tables
    Set oRngHeading = oTbl.Range.GoTo(What:=wdGoToHeading, Which:=wdGoToPrevious, Count:=1).Paragraphs(1).Range
    Do Until oRngHeading.Paragraphs(1).OutlineLevel = lngLevel
      Set oRngHeading = oRngHeading.GoTo(What:=wdGoToHeading, Which:=wdGoToPrevious, Count:=1).Paragraphs(1).Range
    Loop
    oRngHeading.MoveEnd Unit:=wdCharacter, Count:=-1
    oTbl.Range.InsertCaption Label:="Table", Title:=" - " & oRngHeading.Text, Position:=wdCaptionPositionBelow, ExcludeLabel:=0
  Next
lbl_Exit:
  Exit Sub
End Sub