Working with shapes in word from excel VBA

[atr140]

All,

I am trying to loop through a word document and add bookmarks to all shapes (which are inserted pictures). I have successfully done this when the pictures were inline shapes.

Successful code when inline shapes

Private Sub LoopThroughDocument_Bookmark()

    'Define sub/func for error handler
    Dim sSubFunc As String: sSubFunc = "LoopThroughDocument_Bookmark"

    On Error GoTo eh

1:    Dim i As Long
2: With oDoc
3: For i = 1 To .inlineshapes.Count: Debug.Print .inlineshapes.Count
4: If .inlineshapes.Item(i).Type = 3 Then 'wdInlineShapePicture enumeration = 3

'Add Bookmarks to photos - hyperlinks will be made in later step
5: .Bookmarks.Add Name:="P" & i, Range:=.inlineshapes(i).Range: 'Debug.Print i

'Add Hyperlink to Cover page - bookmark will be made in later steps
6: .Hyperlinks.Add Anchor:=.inlineshapes(i).Range, Address:="", _
SubAddress:="TB" & i, ScreenTip:="", TextToDisplay:=v
7: End If
8: Next i
9:    End With


Done:
Exit Sub
eh:
   RaiseError Err.Number, Err.Source, sModule & "." & sSubFunc, Err.Description, Erl

End Sub

As stated previously, some word docs have the pictures inserted as shapes. I assumed this was a simple fix like:

Private Sub LoopThroughDocument_Bookmark2()

    'Define sub/func for error handler
    Dim sSubFunc As String: sSubFunc = "LoopThroughDocument_Bookmark2"

    On Error GoTo eh

1:    Dim i As Long
2: With oDoc
3: For i = 1 To .Shapes.Count:

'Add Bookmarks to photos - hyperlinks will be made in later step
5: .Bookmarks.Add Name:="P" & i, Range:=.Shapes(i).Range: 'Debug.Print i

'Add Hyperlink to Cover page - bookmark will be made in later steps
6: .Hyperlinks.Add Anchor:=.Shapes(i).Range, Address:="", _
SubAddress:="TB" & i, ScreenTip:="", TextToDisplay:=v
8: Next i
9:    End With

Done:
Exit Sub
eh:
   RaiseError Err.Number, Err.Source, sModule & "." & sSubFunc, Err.Description, Erl

End Sub

I have tried many different approaches however I keep getting an error on line 5 (Object doesn't support this property). I used the macro recorder within word to try to figure out the syntax. The macro recorder does produce results, but the shape must be selected, and then the Range property of the boomark add is Selection.Range. I was trying to stay away from a select solution, but I decided to give it a try anyways. This resulted in the same error.

Private Sub LoopThroughDocument_Bookmark2()

    'Define sub/func for error handler
    Dim sSubFunc As String: sSubFunc = "LoopThroughDocument_Bookmark2"

    On Error GoTo eh

1:    Dim i As Long
2: With oDoc
3: For i = 1 To .Shapes.Count:

.Shapes(i).select

'Add Bookmarks to photos - hyperlinks will be made in later step
5: .Bookmarks.Add Name:="P" & i, Range:=Selection.Range: 'Debug.Print i

'Add Hyperlink to Cover page - bookmark will be made in later steps
6: .Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
SubAddress:="TB" & i, ScreenTip:="", TextToDisplay:=v
8: Next i
9:    End With

Done:
Exit Sub
eh:
   RaiseError Err.Number, Err.Source, sModule & "." & sSubFunc, Err.Description, Erl

End Sub

Thanks in advance for the help

 

[NdNoviceHlp]

You are welcome. Thanks for posting your outcome. Dave