Remove All Object Hyperlinks and Screentips with VBA

[TFCJamieFay]

Hi all,

I'm trying to delete all object hyperlinks and screen tips in a given worksheet. I have a map of the USA, made up of 50-odd individual shapes for each state. Each state has a hyperlink and a screen tip showing the value a the metric selected when you hover the mouse over it. What I want to do is remove all screen tips and Hyperlinks, colour the shape/state based on the value of the metric selected and include this value in the screen tip.

The error message I'm getting is "The object doesn't support this property or method". I'm using Excel 2007.

Many thanks,

Jamie

Here is my code so far:

Option Explicit

Sub macUpdateReport()

'On Error GoTo ErrorHandler

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    'Dimension variables
    Dim strState As String
    Dim intCounter As Long
    Dim intLastrow As Long

    'Move values to correct cell
    Sheets("Settings").Range("Date_ID").Value = Sheets("Settings").Range("Temp_Date_ID").Value
    Sheets("Settings").Range("Metric_ID").Value = Sheets("Settings").Range("Temp_Metric_ID").Value

    'Set number format based on metric selected
    Select Case UCase(Sheets("Settings").Range("Metric_ID").Value)
        Case 1, 2, 3, 4, 5
            Sheets("Chart").Range("Display_Values").NumberFormat = "#,##0 "
        Case 6
            Sheets("Chart").Range("Display_Values").NumberFormat = "$ #,##0"
        Case 7, 9
            Sheets("Chart").Range("Display_Values").NumberFormat = "0.0 "
        Case 8, 10
            Sheets("Chart").Range("Display_Values").NumberFormat = "#,##0.00 "
        Case 11, 12
            Sheets("Chart").Range("Display_Values").NumberFormat = "#,##0.0% "
        Case Else
            'Do nothing...
    End Select

    'Colours each state based on rank
    intLastrow = Sheets("Chart").Range("B" & Rows.Count).End(xlUp).Row
    For intCounter = 23 To intLastrow Step 1
        strState = Sheets("Chart").Range("B" & intCounter).Value
        Select Case UCase(strState)
            Case "ALABAMA", "ALASKA", "ARIZONA", "ARKANSAS", "CALIFORNIA", "COLORADO", "CONNECTICUT", _
                "DELAWARE", "FLORIDA", "GEORGIA", "HAWAII", "IDAHO", "ILLINOIS", "INDIANA", "IOWA", _
                "KANSAS", "KENTUCKY", "LOUISIANA", "MAINE", "MARYLAND", "MASSACHUSETTS", "MICHIGAN", _
                "MINNESOTA", "MISSISSIPPI", "MISSOURI", "MONTANA", "NEBRASKA", "NEVADA", "NEW HAMPSHIRE", _
                "NEW JERSEY", "NEW MEXICO", "NEW YORK", "NORTH CAROLINA", "NORTH DAKOTA", "OHIO", _
                "OKLAHOMA", "OREGON", "PENNSYLVANIA", "RHODE ISLAND", "SOUTH CAROLINA", "SOUTH DAKOTA", _
                "TENNESSEE", "TEXAS", "UTAH", "VERMONT", "VIRGINIA", "WASHINGTON", "WEST VIRGINIA", _
                "WISCONSIN", "WYOMING"

                Select Case UCase(Sheets("Chart").Range("K" & intCounter).Value)
                    Case 1
                        With Worksheets("Chart").Shapes(strState)
                            .Fill.ForeColor.RGB = RGB(255, 255, 255)
                            .Hyperlinks.Add ScreenTip:=strState & " " & _
                                Sheets("Chart").Range("D" & intCounter).Value  'Error's out here
                        End With
                    Case 2
                        With Worksheets("Chart").Shapes(strState)
                            .Fill.ForeColor.RGB = RGB(255, 201, 233)
                            .Hyperlinks.Add Anchor:="", Address:="", ScreenTip:=strState & " " & _
                                Sheets("Chart").Range("D" & intCounter).Value
                        End With
                    Case 3
                        With Worksheets("Chart").Shapes(strState)
                            .Fill.ForeColor.RGB = RGB(255, 139, 208)
                            .Hyperlinks.Add Anchor:="", Address:="", ScreenTip:=strState & " " & _
                                Sheets("Chart").Range("D" & intCounter).Value
                        End With
                    Case 4
                        With Worksheets("Chart").Shapes(strState)
                            .Fill.ForeColor.RGB = RGB(255, 63, 177)
                            .Hyperlinks.Add Anchor:="", Address:="", ScreenTip:=strState & " " & _
                                Sheets("Chart").Range("D" & intCounter).Value
                        End With
                    Case 5
                        With Worksheets("Chart").Shapes(strState)
                            .Fill.ForeColor.RGB = RGB(236, 0, 140)
                            .Hyperlinks.Add Anchor:="", Address:="", ScreenTip:=strState & " " & _
                                Sheets("Chart").Range("D" & intCounter).Value
                        End With
                    Case 6
                        With Worksheets("Chart").Shapes(strState)
                            .Fill.ForeColor.RGB = RGB(208, 0, 124)
                            .Hyperlinks.Add Anchor:="", Address:="", ScreenTip:=strState & " " & _
                                Sheets("Chart").Range("D" & intCounter).Value
                        End With
                    Case 7
                        With Worksheets("Chart").Shapes(strState)
                            .Fill.ForeColor.RGB = RGB(168, 0, 100)
                            .Hyperlinks.Add Anchor:="", Address:="", ScreenTip:=strState & " " & _
                                Sheets("Chart").Range("D" & intCounter).Value
                        End With
                    Case 8
                        With Worksheets("Chart").Shapes(strState)
                            .Fill.ForeColor.RGB = RGB(118, 0, 70)
                            .Hyperlinks.Add Anchor:="", Address:="", ScreenTip:=strState & " " & _
                                Sheets("Chart").Range("D" & intCounter).Value
                        End With
                    Case 9
                        With Worksheets("Chart").Shapes(strState)
                            .Fill.ForeColor.RGB = RGB(58, 0, 35)
                            .Hyperlinks.Add Anchor:="", Address:="", ScreenTip:=strState & " " & _
                                Sheets("Chart").Range("D" & intCounter).Value
                        End With
                    Case 10
                        With Worksheets("Chart").Shapes(strState)
                            .Fill.ForeColor.RGB = RGB(0, 0, 0)
                            .Hyperlinks.Add Anchor:="", Address:="", ScreenTip:=strState & " " & _
                                Sheets("Chart").Range("D" & intCounter).Value
                        End With
                End Select
        End Select
    Next intCounter

    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

'Exit Sub

'ErrorHandler:
'    MsgBox "There has been an error.  Please note down the following details and pass to eCommerce:" _
        & vbCrLf & vbCrLf & "Error Number: " & Err.Number & vbCrLf & _
        "Error Despcription: " & Err.Description & vbCrLf & vbCrLf & _
        "Thank you.", vbCritical + vbOKOnly, "Error"
'    With Application
'        .DisplayAlerts = True
'        .ScreenUpdating = True
'    End With
'    Exit Sub

End Sub

 

[TFCJamieFay]

Bump!

I'm not looking for help with all of the code, just the line adding the hyperlink to the shape. I am looping through all the shapes (named after each state) and colouring them and adding an empty hyperlink so I can have a screen tip to display the name of the State and a given value. The user doesn't click the State, just hover over to see the value.

Here is the line I'm having problems with:

Select Case UCase(Sheets("Chart").Range("K" & intCounter).Value)
                    Case 1
                        With Worksheets("Chart").Shapes(strState)
                            .Fill.ForeColor.RGB = RGB(255, 255, 255)
                            .Hyperlinks.Add ScreenTip:=strState & " " & _
                                Sheets("Chart").Range("D" & intCounter).Value  'Error's out here
                        End With

The loop works fine and if I remove or comment out the .Hyperlinks.Add line it will colour all States as desired. It's just the hyperlink that is causing problems.

Any help would be great.

Many thanks,

Jamie

 

[TFCJamieFay]

Solved!

I found a post on here (Sorry I didn't keep the link/ref #) that was doing something similar. I adapted it and the following code is what I'm now using:

'shtChart is the worksheet the objects are in.  This Var. was set earlier in the proc
                        With shtChart
                            Set objState = .Shapes(strState)
                            .Hyperlinks.Add Anchor:=objState, Address:="", ScreenTip:=objState.Name & " " & strDisplayValue
                            .Shapes(strState).Fill.ForeColor.RGB = RGB(255, 255, 255)
                        End With

I've posted incase anyone else has similar issues.