Extracting hyperlink from a picture

Hello,

Can you right-click on the image and check out the hyperlink?

Perhaps loop through the sheet's shapes and check out the links, e.g.,<font face=Courier New><SPAN style="color:darkblue">Sub</SPAN> HyperCurious()<SPAN style="color:darkblue">Dim</SPAN> shp<SPAN style="color:darkblue">As</SPAN> Shape<SPAN style="color:darkblue">For</SPAN><SPAN style="color:darkblue">Each</SPAN> shp<SPAN style="color:darkblue">In</SPAN> Worksheets(1).Shapes
    MsgBox shp.Hyperlink.Address<SPAN style="color:green">'do something here</SPAN><SPAN style="color:darkblue">Next</SPAN><SPAN style="color:darkblue">End</SPAN><SPAN style="color:darkblue">Sub</SPAN></FONT>

The following seemed to generate a valid hyperlink from a lookup for me:

Here's what I did that works, based on my understanding of your question. First, an explanation:

Pictures are shapes. So are comment boxes, drawn objects, forms objects, etc. If you have pictures on a sheet, they are named with teh default syntax "Shapes("Picture [number])". There might be hundreds or thousands of pictures, and who knows how they will be named with a number sequence, but the safest bet is they will be named starting with the word default string "Picture".

Also, their location can be identified using the Address property of the TopLeftCell property. Then, all we need to do is offset that address' column a column or two, and fill that offset cell's value with the picture shape's hyperlink address if it has one. The picture might not have a hyperlink address though, so it's a good idea to put an error trap in the code.

If your shapes really are pictures, and they are in, say, column A, then this code will place all hyperlink addresses of those picture shapes in the cell in column C of the same row as the UpperLeftCell of that picture shape.

Works when tested on XL2K3 XP:

Sub Test1()
Application.ScreenUpdating = False
Dim Sh As Shape
For Each Sh In ActiveSheet.Shapes
With Sh
If Left(.Name, 7) = "Picture" Then
On Error Resume Next
Range(.TopLeftCell.Address).Offset(0, 3).Value = .Hyperlink.Address
On Error GoTo 0
End If
End With
Next Sh
Application.ScreenUpdating = True
End Sub

Quick tack-on to Tom's sapient advice. The Type property might be a good one here too eh. E.g.,

<font face=Courier New><SPAN style="color:darkblue">Sub</SPAN> HyperCurious2()
<SPAN style="color:darkblue">Dim</SPAN> shp <SPAN style="color:darkblue">As</SPAN> Shape
<SPAN style="color:darkblue">For</SPAN> <SPAN style="color:darkblue">Each</SPAN> shp <SPAN style="color:darkblue">In</SPAN> Worksheets(1).Shapes
    <SPAN style="color:darkblue">If</SPAN> shp.<SPAN style="color:darkblue">Type</SPAN> = msoPicture Then _
        MsgBox shp.Hyperlink.Address <SPAN style="color:green">'do something here</SPAN>
<SPAN style="color:darkblue">Next</SPAN>
<SPAN style="color:darkblue">End</SPAN> <SPAN style="color:darkblue">Sub</SPAN></FONT>

Tom, 2-2, tight spot... Go Leafs!

Hi Nate - -

I thought about the Type property but did the Picture name thing to be on the safe side. Maybe I'm being too cautious because the Leafs are indeed in a spot but at least got home ice advantage back. All eyes glued to the TV Friday night. Didja notice the Sharks out here are making some noise?

Indeed, Marleau picked 'em up on his back and off they go. So much for a rebuilding year!

Regarding the pick, I was concerned with the opposite, where I can name the picture anything, e.g., 'Fruity Pebbles,' but the type remains constant, e.g.,

After renaming the picture, the following fires:

<font face=Courier New>MsgBox (Sheets(1).Shapes(1).<SPAN style="color:darkblue">Type</SPAN> = msoPicture) & vbLf _
    & Sheets(1).Shapes(1).Name</FONT>

Yikes! Sundin might miss game 5.

Nate - - did you test your code and it worked OK for you? I tested mine on 2 kinds of pictures...one from my hard drive I placed on the sheet, and the other copied straight from the internet. My code worked for both of them, but your code did not work for either of them when I tried it. I must be doing something wrong for your code to not work at all...what object or shape did you test yours on?

Hello again Tom, yes I did, I've tried it three times. First on clip art that I inserted and renamed. Then on a .bmp I inserted, and then on a .jpg.

Hmmm, you'll get an error if you try to work with a sheet that contains no shapes. If you test the type of your shapes do they equal 13?

Yes I did and they are all 13. Bitmap, jpg, no matter what, my code worked fine but...hold on...OK I see now...stupid me with an early glass of Seagrams 7, now I see you referenced the #1 index sheet where my test sheet was index 2. Didn't notice 'til now 'cause I never use index. Your code is fine, works perfect, sorry for the false alarm.

This is great Tom,

1) Nothing like refreshment at the end of the day
2) The madness to method works, if it lines up

It's another option for the OP. On the manual import via Insert -> yadda, yadda, Excel assigns 'Picture X' to the shape. I just got to thinking that I'm not confident that this is the naming phenomenon on any and every given transfer to Excel. While knowing you can't capture every event, and perhaps moot...

Have a nice evening.