Sub ApplyCaptions()
Application.ScreenUpdating = True
Dim RngStry As Range, iShp As InlineShape, oTbl As Table, TmpRng As Range
With ActiveDocument
  For Each iShp In .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
  For Each oTbl In .Tables
    Set TmpRng = oTbl.Range.Paragraphs.Last.Range
    With TmpRng
      If .Paragraphs.Last.Next.Style <> "Caption" Then
        oTbl.Range.InsertCaption Label:="Figure", TitleAutoText:="", _
          Title:="", Position:=wdCaptionPositionBelow, ExcludeLabel:=0
      End If
    End With
  Next
End With
Set TmpRng = Nothing
Application.ScreenUpdating = False
End Sub