Microsoft Office Forums - View Single Post - Generating automatic caption for table based on document section

gmaxey · 07-25-2019, 10:54 AM

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:

Code:

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