Looping through graphics to last graphic

[Steve Finlayson]

I have a macro that inserts paragraphs in a series of pictures to
seperate them and then goes back and inserts the caption for the
figures. Because the number of figures is variable, I would like to
set up the macro to loop until the last figure is reached.

How can I do this?

The code I am using to enter th paragraphs is as follows with the
last 3 lines repeating to the end of the graphics:

Selection.GoTo What:=wdGoToGraphic, Which:=wdGoToFirst, Count:=1,
Name:=""
Selection.Find.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeParagraph
Selection.TypeParagraph
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeParagraph
Selection.TypeParagraph

Then I return to the first graphic and insert the captions with this
code, again repeating the last 3 lines to the end of the graphics:

Selection.GoTo What:=wdGoToGraphic, Which:=wdGoToFirst, Count:=1,
Name:=""
Selection.Find.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.MoveRight Unit:=wdCharacter, Count:=2
Selection.InsertCaption Label:="Figure", TitleAutoText:="",
Title:="", _
Position:=wdCaptionPositionBelow
Selection.MoveRight Unit:=wdCharacter, Count:=3
Selection.InsertCaption Label:="Figure", TitleAutoText:="",
Title:="", _
Position:=wdCaptionPositionBelow

I appreciate any help. Thanks
Steve

 

[Jay Freedman]

Hi, Steve,

This is one of those cases where trying to modify recorded macro code will
steer you seriously wrong. For some reason, recording a GoTo command throws
in completely useless Find code (since there is no .Execute call, all the
setup of .Find parameters is worthless). Additionally, the macro recorder
always uses the Selection object, where a Range object is far more efficient
because it doesn't force scrolling and screen redrawing.

I won't even go into the rant about "don't use blank paragraphs as spacers"
because I don't think it matters for this kind of document.

The following code does what you want with a minimum of fuss.

Sub SeparateAndCaptionPix()
Dim oILS As InlineShape
Dim oRg As Range

For Each oILS In ActiveDocument.InlineShapes
Set oRg = oILS.Range.Duplicate
With oRg
.Collapse wdCollapseEnd
.Text = vbCr & vbCr & vbCr & vbCr
.Collapse wdCollapseEnd
.Move unit:=wdCharacter, Count:=-2
.InsertCaption Label:="Figure", _
Position:=wdCaptionPositionBelow
End With
Next oILS
End Sub

 

[Steve Finlayson]

Thank you. I am not good enough with vb yet to have ever gotten that.
It works perfectly and with a little playing, I think I understand
it.Thanks