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

FrostKo · 03-21-2023, 07:51 PM

This helped tremendously! I ended taking what I needed but it was generating an error if there wasn't two empty paragraphs after the last image. I wanted to share my code. This allows for the error to occur but adds the caption anyway without any empty paragraphs after the last image.

Code:

Sub Captions()
On Error GoTo Error
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
        Exit Sub
Error:
          iShp.Range.InsertCaption Label:="Photo", TitleAutoText:="", _
           Title:="", Position:=wdCaptionPositionBelow, ExcludeLabel:=0
        End If
      End If
    End With
  Next
Next
Set TmpRng = Nothing
Application.ScreenUpdating = False
Resume Next
End Sub