Adding hyperlink "comments" to shapes with vba

[akramer08]

I have a macro that creates a series of connector arrows. I needed a way to add a mouseover comment to the arrows. I just added a hyperlink that if clicked will just put them on the same page, but I added a screentip to it and its exactly what I need. But, each time the macro runs, it will delete all existing arrows then add new arrows connecting different shapes, so the hyperlink and comment will be erased. Any way to add a hyperlink with a screentip to a shape with VBA? Below is my code that adds the arrow.

    With Worksheets(1).Shapes.AddConnector(msoConnectorStraight, 0, 0, 100, 100)
        With .ConnectorFormat
            .BeginConnect ActiveSheet.Shapes(City1), 1
            .EndConnect ActiveSheet.Shapes(City2), 1
        End With
        .RerouteConnections


        .Line.Weight = 0.75
        .Line.DashStyle = msoLineSolid             'msoLineDash for dashed
        .ConnectorFormat.Type = msoConnectorStraight
        .Line.Style = msoLineSingle
        .Line.Transparency = 0#
        .Line.Visible = msoTrue
        .Line.ForeColor.SchemeColor = 10         '17 for green
        .Line.BackColor.RGB = RGB(255, 255, 255)
        .Line.BeginArrowheadLength = msoArrowheadLengthMedium
        .Line.BeginArrowheadWidth = msoArrowheadWidthMedium
        .Line.BeginArrowheadStyle = msoArrowheadNone
        .Line.EndArrowheadLength = msoArrowheadLengthMedium
        .Line.EndArrowheadWidth = msoArrowheadWidthMedium
        .Line.EndArrowheadStyle = msoArrowheadTriangle
    End With

 

[Al Chara]

Let me know if this works for you.

    Dim shp As Shape


    With Worksheets(1)
        Set shp = .Shapes.AddConnector(msoConnectorStraight, 0, 0, 100, 100)
        With shp
            With .ConnectorFormat
                .BeginConnect ActiveSheet.Shapes(City1), 1
                .EndConnect ActiveSheet.Shapes(City2), 1
            End With
            .RerouteConnections
            .Line.Weight = 0.75
            .Line.DashStyle = msoLineSolid             'msoLineDash for dashed
            .ConnectorFormat.Type = msoConnectorStraight
            .Line.Style = msoLineSingle
            .Line.Transparency = 0#
            .Line.Visible = msoTrue
            .Line.ForeColor.SchemeColor = 10         '17 for green
            .Line.BackColor.RGB = RGB(255, 255, 255)
            .Line.BeginArrowheadLength = msoArrowheadLengthMedium
            .Line.BeginArrowheadWidth = msoArrowheadWidthMedium
            .Line.BeginArrowheadStyle = msoArrowheadNone
            .Line.EndArrowheadLength = msoArrowheadLengthMedium
            .Line.EndArrowheadWidth = msoArrowheadWidthMedium
            .Line.EndArrowheadStyle = msoArrowheadTriangle
        End With
        .Hyperlinks.Add Anchor:=shp, Address:="", SubAddress:="A1", ScreenTip:="Enter comment here"
    End With

 

[akramer08]

Works great! Thanks.

 

[akramer08]

One question. Any way to make the comment display a cell value, say Z3?

 

[Al Chara]

Here you go.

    Dim shp As Shape


    With Worksheets(1)
        Set shp = .Shapes.AddConnector(msoConnectorStraight, 0, 0, 100, 100)
        With shp
            With .ConnectorFormat
                .BeginConnect ActiveSheet.Shapes(1), 1
                .EndConnect ActiveSheet.Shapes(2), 1
            End With
            .RerouteConnections
            .Line.Weight = 0.75
            .Line.DashStyle = msoLineSolid             'msoLineDash for dashed
            .ConnectorFormat.Type = msoConnectorStraight
            .Line.Style = msoLineSingle
            .Line.Transparency = 0#
            .Line.Visible = msoTrue
            .Line.ForeColor.SchemeColor = 10         '17 for green
            .Line.BackColor.RGB = RGB(255, 255, 255)
            .Line.BeginArrowheadLength = msoArrowheadLengthMedium
            .Line.BeginArrowheadWidth = msoArrowheadWidthMedium
            .Line.BeginArrowheadStyle = msoArrowheadNone
            .Line.EndArrowheadLength = msoArrowheadLengthMedium
            .Line.EndArrowheadWidth = msoArrowheadWidthMedium
            .Line.EndArrowheadStyle = msoArrowheadTriangle
        End With
        .Hyperlinks.Add Anchor:=shp, Address:="", SubAddress:="A1", ScreenTip:=.Range("Z3").Value
    End With

 

[akramer08]

Doesnt work, I get an error message saying invalid procedure call or argument

 

[Al Chara]

Try the following.

    Dim shp As Shape


    With Worksheets(1)
        Set shp = .Shapes.AddConnector(msoConnectorStraight, 0, 0, 100, 100)
        With shp
            With .ConnectorFormat
                .BeginConnect ActiveSheet.Shapes(City1), 1
                .EndConnect ActiveSheet.Shapes(City2), 1
            End With
            .RerouteConnections
            .Line.Weight = 0.75
            .Line.DashStyle = msoLineSolid             'msoLineDash for dashed
            .ConnectorFormat.Type = msoConnectorStraight
            .Line.Style = msoLineSingle
            .Line.Transparency = 0#
            .Line.Visible = msoTrue
            .Line.ForeColor.SchemeColor = 10         '17 for green
            .Line.BackColor.RGB = RGB(255, 255, 255)
            .Line.BeginArrowheadLength = msoArrowheadLengthMedium
            .Line.BeginArrowheadWidth = msoArrowheadWidthMedium
            .Line.BeginArrowheadStyle = msoArrowheadNone
            .Line.EndArrowheadLength = msoArrowheadLengthMedium
            .Line.EndArrowheadWidth = msoArrowheadWidthMedium
            .Line.EndArrowheadStyle = msoArrowheadTriangle
        End With
        .Hyperlinks.Add Anchor:=shp, Address:="", SubAddress:="A1", ScreenTip:=.Range("Z3").Text
    End With

 

[akramer08]

Perfect. Thanks again for all the help.