Microsoft Office Forums - View Single Post - [Solved] VBA to insert captions without appending to existing captions

macropod · 02-16-2012, 05:02 PM

Hi Marrick,

Oops - I tested with your attachment, saw that it worked and didn't test further.

Try:

Code:

Sub ApplyCaptions()
Application.ScreenUpdating = True
Dim RngStry As Range, iShp As InlineShape, TmpRng As Range
For Each RngStry In ActiveDocument.StoryRanges
  For Each iShp In RngStry.InlineShapes
    Set TmpRng = iShp.Range.Paragraphs.First.Range
    With TmpRng
      If .Style <> "Caption" Then
        If .Paragraphs.Last.Next.Style <> "Caption" Then
          iShp.Range.InsertCaption Label:="Figure", TitleAutoText:="", _
           Title:="", Position:=wdCaptionPositionBelow, ExcludeLabel:=0
        End If
      End If
    End With
  Next
Next
Set TmpRng = Nothing
Application.ScreenUpdating = False
End Sub

As hinted at in my first post, this macro simply looks for the Caption Style - either attached to the inlineshape's own paragraph, or in the following one.