Equivelent to tables collection object for Figures?

[peter.coghill]

HELP!

Im trying to write a macro that will run through a document and when it
comes to a table(works ok) of a figure it adds a caption.

I use the Range.Tables.Count attribute to work out the number of times
I need to run the GoToNext ( table) command so that i can give it a
caption. Probably not the best way to do it i know, open to
suggestions.

I then want to repeat this for all the figures. But cant find a figures
equivelent collection object. Code so far below

Sub AddCaptions()

Dim currentRange As Range
Dim numberOfTables As Integer

ActiveDocument.Bookmarks("\StartOfDoc").Select
Set currentRange = ActiveDocument.Content

numberOfTables = currentRange.Tables.Count


ActiveDocument.Bookmarks("\StartOfDoc").Select
Set currentRange = Selection.Range

For i = 1 To numberOfTables
'MsgBox i
Selection.GoToNext (wdGoToTable)
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.InsertCaption Label:="Table",
TitleAutoText:="InsertCaption1", Title:=" ",
Position:=wdCaptionPositionBelow
Selection.Delete
Selection.TypeText (": ")

Next
''OK UP TO HERE

ActiveDocument.Bookmarks("\StartOfDoc").Select
Set currentRange = Selection.Range


Do Until Selection.GoToNext(wdGoToGraphic) ''WHAT DO I NEED TO PUT
IN THE LOOP CONDITION TO MAKE IT HAPPEN?

Selection.MoveDown Unit:=wdLine, Count:=1
Selection.InsertCaption Label:="Figure",
TitleAutoText:="InsertCaption1", Title:=" ",
Position:=wdCaptionPositionBelow
Loop

End Sub

 

[peter.coghill]

thanks dave, got there on my own in the end. My solution looks very
similar, little less efficient tho i think

Regards
Pete



Sub AddCaptions()

Dim currentRange As Range
Dim numberOfTables As Integer
Dim numberOfFigures As Integer


ActiveDocument.Bookmarks("\StartOfDoc").Select
Set currentRange = ActiveDocument.Content

numberOfTables = currentRange.Tables.Count


ActiveDocument.Bookmarks("\StartOfDoc").Select
Set currentRange = Selection.Range

For i = 1 To numberOfTables

Selection.GoToNext (wdGoToTable)
'MsgBox "range: " & Selection.Range.Start & " - " &
Selection.Range.End
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.InsertCaption Label:="Table",
TitleAutoText:="InsertCaption1", Title:=" ",
Position:=wdCaptionPositionBelow
Selection.Delete
Selection.TypeText (": ")

Next


Set currentRange = ActiveDocument.Content
numberOfFigures = currentRange.InlineShapes.Count

'MsgBox " " & numberOfFigures

ActiveDocument.Bookmarks("\StartOfDoc").Select
Set currentRange = Selection.Range

For i = 1 To numberOfFigures

Selection.GoToNext (wdGoToGraphic)
'MsgBox "range: " & Selection.Range.Start & " - " &
Selection.Range.End
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.InsertCaption Label:="Figure",
TitleAutoText:="InsertCaption1", Title:=" ",
Position:=wdCaptionPositionBelow
'Selection.Delete
Selection.TypeText (": ")

Next

End Sub

 

[peter.coghill]

Many thanks Dave, got there on my own in the end, see below. but i
think yours is better.

PC

++++++++++++++++++++++++++++++

Sub AddCaptions()
Dim currentRange As Range
Dim numberOfTables As Integer
Dim numberOfFigures As Integer


ActiveDocument.Bookmarks("\StartOfDoc").Select
Set currentRange = ActiveDocument.Content

numberOfTables = currentRange.Tables.Count


ActiveDocument.Bookmarks("\StartOfDoc").Select
Set currentRange = Selection.Range

For i = 1 To numberOfTables

Selection.GoToNext (wdGoToTable)
'MsgBox "range: " & Selection.Range.Start & " - " &
Selection.Range.End
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.InsertCaption Label:="Table",
TitleAutoText:="InsertCaption1", Title:=" ",
Position:=wdCaptionPositionBelow
Selection.Delete
Selection.TypeText (": ")

Next


Set currentRange = ActiveDocument.Content
numberOfFigures = currentRange.InlineShapes.Count

'MsgBox " " & numberOfFigures

ActiveDocument.Bookmarks("\StartOfDoc").Select
Set currentRange = Selection.Range

For i = 1 To numberOfFigures

Selection.GoToNext (wdGoToGraphic)
'MsgBox "range: " & Selection.Range.Start & " - " &
Selection.Range.End
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.InsertCaption Label:="Figure",
TitleAutoText:="InsertCaption1", Title:=" ",
Position:=wdCaptionPositionBelow
'Selection.Delete
Selection.TypeText (": ")

Next

End Sub