I routinely work with large documents that have
many tables and figures. I have code that iterates through a document looking at all tables for captions. It looks for the presence of a field code above the table. If there isn't one, it adds a caption. I believe Andrew Lockton (a/k/a Guessed) graciously helped with this years ago. I have recently attempted to adapt the code for figures (inline shapes). Unfortunately, it adds a caption below
all inline shapes whether or not a caption already exists. I am hoping an expert, here, can look at the code and identify the error(s) or tell me whether what I'm trying to accomplish can even be done.
Thank you in advance for considering my request for help.
Code:
Sub CheckAllFigures()
Dim iShape As InlineShape
Dim myBigRange As Range
Dim MyRange As Range
Application.ScreenUpdating = False
On Error GoTo ErrorHandler
Set myBigRange = ActiveDocument.Range
'Process figures within the entire document
For Each iShape In myBigRange.InlineShapes
iShape.Select
'Look at para below the figure. Caption there? If not, add one.
Selection.MoveDown Unit:=wdLine, Count:=1
Set MyRange = Selection.Paragraphs(1).Range
objShape.Select
If MyRange.Fields.Count = 0 Then
Selection.InsertCaption Label:="Figure", TitleAutoText:="", _
Title:=". ", Position:=wdCaptionPositionBelow, ExcludeLabel:=0
ElseIf MyRange.Fields(1).Type <> wdFieldSequence Then
Selection.InsertCaption Label:="Figure", TitleAutoText:="", _
Title:=". ", Position:=wdCaptionPositionBelow, ExcludeLabel:=0
End If
Next iShape 'Go to next shape
Set MyRange = Nothing
Set myBigRange = Nothing
Application.ScreenUpdating = True
Application.ScreenRefresh
MsgBox "Done!", vbInformation
Exit Sub 'If you get this far - avoid the error handler
ErrorHandler:
MsgBox "Error: " & Err.Number & vbCr & Err.Description
End Sub