If you want to extract hyperlink address from shapes. Try this macro
Sub extract_hyperlink_from_shapes()
Dim sh As Shape
Dim x As Long
x = 1
Range("a:a").Clear
For Each sh In ActiveSheet.Shapes
If sh.Type = msoPicture Then
On Error Resume Next
Range("a" & x).Value = sh.Name
Range("b" & x).Value = sh.Hyperlink.Address
x = x + 1
End If
Next
End Sub
Sub extract_hyperlink_from_shapes()
Dim sh As Shape
Dim x As Long
x = 1
Range("a:a").Clear
For Each sh In ActiveSheet.Shapes
If sh.Type = msoPicture Then
On Error Resume Next
Range("a" & x).Value = sh.Name
Range("b" & x).Value = sh.Hyperlink.Address
x = x + 1
End If
Next
End Sub
Steps to Use
- Copy the below code
- Press Alt+F11 to open VBA editor
- Paste it in any public module or module 1
- Select the sheet having shapes and run the macro
No comments:
Post a Comment