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
As stated previously, some word docs have the pictures inserted as shapes. I assumed this was a simple fix like:
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.
Thanks in advance for the help
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
VBA Code:
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 SubAs stated previously, some word docs have the pictures inserted as shapes. I assumed this was a simple fix like:
VBA Code:
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 SubI 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.
VBA Code:
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 SubThanks in advance for the help
