VBA Command To Add A Link To A Shape

[MikeG]

I have code that creates a new rectangle and I would like to add a hyperlink to the shape.

The code is attached to a button in a sheet called Master and the code creates a new shape in a sheet called Sheet A. The name created for the shape is stored in a variable called NewName.

Set MyShape = Sheets(Sheet A).Shapes.AddShape(msoShapeRectangle, BFL, BT, BW, BH)
MyShape.Name = NewName

Could someone give me the code that would add a hyperlink to the new button so that it would link to Cell A1 in a sheet I have named Products?

Thanks

Mike

 

[GWteB]

You don't need a hyperlink, just an extra macro. Extend your code as per below:

Set MyShape = Sheets(Sheet A).Shapes.AddShape(msoShapeRectangle, BFL, BT, BW, BH)
MyShape.Name = NewName
MyShape.OnAction = "Jump"

The extra macro would look like this:

Public Sub Jump()
    Application.Goto Reference:=Worksheets("Products").Range("A1")
End Sub

 

[MikeG]

You don't need a hyperlink, just an extra macro. Extend your code as per below:

Set MyShape = Sheets(Sheet A).Shapes.AddShape(msoShapeRectangle, BFL, BT, BW, BH)
MyShape.Name = NewName
MyShape.OnAction = "Jump"

The extra macro would look like this:

Public Sub Jump()
    Application.Goto Reference:=Worksheets("Products").Range("A1")
End Sub

Thanks GWteB.

Unfortunately my client won't accept a workbook with any macros in and want to just have hyperlinks, so I am looking for the code to create the hyperlinks, and once that is done, I will remove all macros from the workbook.

 

[rlv01]

Something like this perhaps.

Sub AddShape()
 Dim WS As Worksheet
    Dim MyShape As Shape
    Dim HL As Hyperlink
    Dim BFL, BT, BW, BH
    Dim NewName As String
    
    
    Set WS = Worksheets("Sheet A")
    NewName = "NewShape"
    
    BFL = 100
    BT = 500
    BW = 80
    BH = 30
    
    Set MyShape = WS.Shapes.AddShape(msoShapeRectangle, BFL, BT, BW, BH)
    MyShape.Name = NewName
    Set HL = WS.Hyperlinks.Add(Anchor:=MyShape, Address:="", SubAddress:="Products!A1")
End Sub

 

[MikeG]

Something like this perhaps.

Sub AddShape()
 Dim WS As Worksheet
    Dim MyShape As Shape
    Dim HL As Hyperlink
    Dim BFL, BT, BW, BH
    Dim NewName As String
   
   
    Set WS = Worksheets("Sheet A")
    NewName = "NewShape"
   
    BFL = 100
    BT = 500
    BW = 80
    BH = 30
   
    Set MyShape = WS.Shapes.AddShape(msoShapeRectangle, BFL, BT, BW, BH)
    MyShape.Name = NewName
    Set HL = WS.Hyperlinks.Add(Anchor:=MyShape, Address:="", SubAddress:="Products!A1")
End Sub

Thanks! Perfect - just what I was looking for.

 

[MikeG]

Thanks! Perfect - just what I was looking for.

I wonder if you could help me on a follow up.

In the last part of the code I changed the line:

SubAddress:="Products!A1"

to

SubAddress:="Products Two!A1"

and the macro no longer worked., even though the sheet Products Two exists. I did some more experiments, and any time the sheet name has a space, the macro does not work.

Is there something I am doing incorrectly?

Thanks again

 

[MikeG]

I wonder if you could help me on a follow up.

In the last part of the code I changed the line:

SubAddress:="Products!A1"

to

SubAddress:="Products Two!A1"

and the macro no longer worked., even though the sheet Products Two exists. I did some more experiments, and any time the sheet name has a space, the macro does not work.

Is there something I am doing incorrectly?

Thanks again

Just realized that it is necessary to add single quotes around when the name has a space! So I'm all set. Appreciate it.

 

[GWteB]

Glad we could help & thanks for the follow-up