Dynamically add a hyperlink to a shape in VBA

[hamfinite]

I am trying to create a table of contents for a very long list of items on a sheet. I am using shapes on a seperate sheet to act as buttons, that go to the location on the correct sheet using a hyperlink. I found how to add a hyperlink using a macro, but I can't find how to create a hyperlink for the shape using a macro.

What is the code I would need to set a hyperlink to "Sheet1!A2:Sheet1!C2", with the a tooltip of "Some text"?

Here is how I create the shapes:

With myDocument.Shapes.AddShape(msoShapeRoundedRectangle, 10, IntVerticalOffset, 630, IntHeight) 
    .Fill.ForeColor.RGB = RGB(204, 255, 204)
    .Line.ForeColor.RGB = RGB(0, 0, 0)
    .TextFrame.Characters.Text = StrRowName
    .TextFrame.HorizontalAlignment = xlHAlignLeft
    .TextFrame.Characters.Font.ColorIndex = xlAutomatic
    .TextFrame.Characters.Font.FontStyle = "Bold"
    .Locked = True
End With

 

[hamfinite]

As a note, I found this, but I'm not sure how it applies to my With statement, instead of a selection.

http://www.ozgrid.com/forum/showthread.php?t=64831

 

[JSA715]

you could write a macro to select that range. then have the shape tied to the macro.

 

[Zack Barresse]

I was just about to post that example when I refreshed and saw JSA had given that... I guess here it is anyway...



<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> testingmenowplzzzz()<br>    <SPAN style="color:#00007F">Dim</SPAN> myDocument <SPAN style="color:#00007F">As</SPAN> Worksheet, IntVerticalOffset <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, IntHeight<br>    <SPAN style="color:#00007F">Dim</SPAN> StrRowName <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, strAddy <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, rngSelected <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#00007F">Set</SPAN> myDocument = ActiveSheet<br>    IntVerticalOffset = 20<br>    IntHeight = 50<br>    StrRowName = "one"<br>    <SPAN style="color:#00007F">With</SPAN> myDocument.Shapes.AddShape(msoShapeRoundedRectangle, 10, IntVerticalOffset, 60, IntHeight)<br>        .Fill.ForeColor.RGB = RGB(204, 255, 204)<br>        .Line.ForeColor.RGB = RGB(0, 0, 0)<br>        .TextFrame.Characters.Text = StrRowName<br>        .TextFrame.HorizontalAlignment = xlHAlignLeft<br>        .TextFrame.Characters.Font.ColorIndex = xlAutomatic<br>        .TextFrame.Characters.Font.FontStyle = "Bold"<br>        .Locked = <SPAN style="color:#00007F">True</SPAN><br>        .OnAction = "Module1.MySelect"<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><br><SPAN style="color:#00007F">Sub</SPAN> MySelect()<br>    <SPAN style="color:#00007F">With</SPAN> Sheets("Sheet1")<br>        .Select<br>        .Range("A1:C1").Select<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[hamfinite]

you could write a macro to select that range. then have the shape tied to the macro.

That would require me to dynamically create and link about 180 macros, every time I create a document's navigation page! Not acceptable, because allowing MY macro to edit the code means a virus could also edit the code. At least that's what I understand.

 

[Zack Barresse]

And I'd say if you don't understand the security of it, you probably shouldn't even be doing it. Excel is not secure, and macros can get in, but if you are careful before it is ever opened in Excel you should be good. I [basically] have used Low security for 5+ years now and never had a virus, not once. But I'm very careful about what I open and what I allow in.

Why would you not want to do that? You could loop through all objects and append the onAction property of it to one sub, add that sub (one time) and be done. Not sure why that won't work. Can you explain a bit more?

 

[RoryA]

Something like:

Dim shp As Shape
With mydocument
   Set shp = .Shapes.AddShape(msoShapeRoundedRectangle, 10, intVerticalOffset, 630, IntHeight)
   With shp
      .Fill.ForeColor.RGB = RGB(204, 255, 204)
      .Line.ForeColor.RGB = RGB(0, 0, 0)
      .TextFrame.Characters.Text = strRowName
      .TextFrame.HorizontalAlignment = xlHAlignLeft
      .TextFrame.Characters.Font.ColorIndex = xlAutomatic
      .TextFrame.Characters.Font.FontStyle = "Bold"
      .Locked = True
   End With
   .Hyperlinks.Add Anchor:=shp, Address:="", SubAddress:="Sheet1!A1:c2", ScreenTip:="blah"
End With

 

[hamfinite]

Dim shp As Shape
With mydocument
   Set shp = .Shapes.AddShape(msoShapeRoundedRectangle, 10, intVerticalOffset, 630, IntHeight)
   With shp
      .Fill.ForeColor.RGB = RGB(204, 255, 204)
      .TextFrame.Characters.Text = strRowName
   End With
   .Hyperlinks.Add Anchor:=shp, Address:="", SubAddress:="Sheet1!A1:c2", ScreenTip:="blah"
End With

Yay! It... sort of worked. I now have hyperlinks on all my shapes, but get this odd error: Reference is not valid.
Now what?

I have another related question: When I add the hyperlink, will it go away if I delete the shapes, or will it stick around when I delete the shapes on the navigation page and re-make the page?

Thank you!

 

[hamfinite]

I found the reason the "Reference is not valid" error came up!

I didn't have single quotes around my sheet name.

.Hyperlinks.Add Anchor:=shp, Address:="", SubAddress:="'Sheet One'!A1:C1", ScreenTip:="Screen Tip String"

 

[RoryA]

For the other part of your question, the hyperlink is attached to the shape, so if you delete the shape, the link is gone too.