Error Adding Hyperlinks Dynamically to Shapes

The_Steward

Board Regular
Joined
Nov 26, 2020
Messages
63
Office Version
  1. 365
Platform
  1. Windows
The below macro ran successfully until I tried adding hyperlinks to it. I can't seem to define the Anchor correctly. any suggestions are appreciated.

I am trying to create a directory to 20 different sheets (I have the loop set to 3 while testing) so that users can easily access their client data.

VBA Code:
Sub Create_SilButton()

'Still need to change formatting + add hyperlink and Screentip

Dim macrobook As Workbook
Set macrobook = ThisWorkbook

Dim namesheet As Worksheet
Set namesheet = macrobook.Sheets("Code and Data Centre")
Dim nameslastrow As Long
nameslastrow = namesheet.Cells(Rows.Count, 1).End(xlUp).Row
Dim names As Long
Dim y As Long
Dim x As Long

Dim shapesloop As Long


Dim SilSelection As Worksheet
Set SilSelection = macrobook.Sheets("SIL House Selection")


SilSelection.Activate
x = 300
y = 180

names = 4



For shapesloop = 1 To 3
Dim shapes As Shape
Set shapes = SilSelection.shapes.AddShape(msoShapeRoundedRectangle, x, y, 370, 30)

shapes.Fill.ForeColor.RGB = RGB(191, 194, 211)


    With shapes.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(70, 74, 100)
        .Transparency = 0
    End With
    Application.CommandBars("Format Object").Visible = False
    shapes.TextFrame2.TextRange.Font.Bold = msoTrue
    shapes.TextFrame2.TextRange.ParagraphFormat.Alignment = _
        msoAlignCenter
    shapes.TextFrame2.VerticalAnchor = msoAnchorMiddle
    With shapes.TextFrame2.TextRange.Font
        .NameComplexScript = "Helvetica"
        .NameFarEast = "Helvetica"
        .Name = "Helvetica"
    End With
    shapes.Name = "S1"
    
    Set HLShape = SilSelection.shapes("S1")
    
    SilSelection.Hyperlinks.Add Anchor:=HLShape, Address:="", SubAddress:=namesheet.Cells(names, 8), ScreenTip:="Please Click"
    shapes.TextFrame2.TextRange.Font.Size = 18
    shapes.TextFrame.Characters.Text = namesheet.Cells(names, 10)
    
    
    
    

y = y + 60

names = names + 1

x = 300

Next shapesloop


End Sub
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
For the SubAddress, try the following instead...

VBA Code:
SubAddress:=namesheet.Cells(names, 8).Address(external:=True)

Hope this helps!
 
Upvote 0
Thankyou it does but it now goes directly to the cell with the sheet name instead of sheet itself. It seems I need to extract the string from the cell where the link is currently going. I have added pictures to
Screenshot of SIL Code and Date Centre 2023-01-06 152811.png
Screenshot of SIL House 1 2023-01-06 153332.png
 
Upvote 0
Thankyou it does but it now goes directly to the cell with the sheet name instead of sheet itself. It seems I need to extract the string from the cell where the link is currently going. I have added pictures to View attachment 82255View attachment 82256
I need the hyperlink for the first button to go to the sheet named "SIL House 1", second button the sheet named SILHouse 2 and so forth. the buttons are currently going to H4, H5, H6 in Picture 1. So I know its close!
 
Upvote 0
Oh I see, in that case, I think the following should do...

VBA Code:
SubAddress:="'SIL House " & shapesloop & "'!A1"

Does this help?
 
Upvote 0
Solution
YES!!! Thankyou so much. I just had to change the spaces but otherwise perfect!
 
Upvote 0
That's great, I'm glad you've got it working.

Cheers!
 
Upvote 0
Btw one thing I realised I am missing is the ability for text on the buttons to change when I change address (Address names are listed in column J in first picture and updated when changes are made to the corresponding sheet) in H7 of second picture second picture i.e if I changed "J House" to "T House" the text on button should change to "T House". The buttons generate the correct text when created but won't change from there. Would you recommend creating new Macro to do this or adding it to Macro above?
 
Upvote 0
Sorry, but I haven't looked at the rest of your code that closely, so I'm a little lost. In any case, since this is a new question, I would suggest that you start a new thread and post your question there.
 
Upvote 0

Forum statistics

Threads
1,214,614
Messages
6,120,533
Members
448,969
Latest member
mirek8991

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top