Nat Aes
Nat Aes

Reputation: 927

Excel Chart Hyperlink

I use the following code to add a hyperlink to a chart, linking it to a different worksheet:

ActiveSheet.ChartObjects("Chart 3").Activate
ActiveChart.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:="", SubAddress:= _
    "'Sheet2'!A1"

However this creates a link that is activated when clicking on the entire chart. The pie chart has 4 segments (each relating to a different series) and I would like each segment to link to a different worksheet. So the first segment will go to Sheet2, the second segment to Sheet3 and so on.

Is there a way to add an anchor to each individual segment rather than to the entire chart as a whole?

Upvotes: 0

Views: 3758

Answers (2)

Arthur D. Howland
Arthur D. Howland

Reputation: 4557

It took me 12 hours because I had the same question. Here is how I got it to work starting from a brand new excel workbook:

1) Make up the data for a pie chart

Name    Score
Art     20
Bob     15
Joe     19
Tim     5

2) Insert a pie chart so that it appears as an object in the same worksheet

3) Right click "view code" on the Sheet1 tab.

4) Insert a "Class Module" -- probably called "Class1" by default

5) Paste the following code into the Class Module:


Option Explicit

Public WithEvents ChartObject As Chart

Private Sub ChartObject_MouseUp(ByVal Button As Long, ByVal Shift As Long, _
        ByVal x As Long, ByVal y As Long) 

    Dim ElementID As Long, Arg1 As Long, Arg2 As Long
    Dim myX As Variant, myY As Double

    With ActiveChart
        ' Pass x & y, return ElementID and Args
        .GetChartElement x, y, ElementID, Arg1, Arg2

        ' Did we click over a point or data label?
        If ElementID = xlSeries Or ElementID = xlDataLabel Then
            If Arg2 > 0 Then
                ' Extract x value from array of x values
                myX = WorksheetFunction.Index _
                    (.SeriesCollection(Arg1).XValues, Arg2)

                ' Extract y value from array of y values
                myY = WorksheetFunction.Index _
                    (.SeriesCollection(Arg1).Values, Arg2)

                ' Display message box with point information
                MsgBox "Series " & Arg1 & vbCrLf _
                    & """" & .SeriesCollection(Arg1).Name & """" & vbCrLf _
                    & "Point " & Arg2 & vbCrLf _
                    & "X = " & myX & vbCrLf _
                    & "Y = " & myY

                  Range("A1").Select

                ' Don't crash if chart doesn't exist
                On Error Resume Next
                ' Activate the appropriate chart
                ' ThisWorkbook.Charts("Chart " & myX).Select
                Sheets("Series " & myX & " Detail").Select
                Range("A1").Select
                On Error GoTo 0
            End If
        End If
    End With
End Sub

6) The above code works only if we can trick excel to treating "chartobjects" as "charts". To do that: Open the code "This Workbook" using view code. 7) Paste the following:

Dim ChartObjectClass As New Class1

Private Sub Workbook_Open() Set ChartObjectClass.ChartObject = Worksheets(1).ChartObjects(1).Chart End Sub

8) The coding in the class module is rigged to go to tabs named "Series Art Detail", "Series Joe Detail", "Series Bob Detail", and Series "Tim Detail" Create those 4 tabs. The mapping of the pie slices to the tabs is near the bottom line in the Class code.

9) Test and enjoy!

Upvotes: 1

Nat Aes
Nat Aes

Reputation: 927

Use the following code:

Option Explicit

Public WithEvents CHT As Chart

Private Sub Workbook_Open()
    Set CHT = ActiveSheet.ChartObjects(1).Chart
End Sub

Private Sub CHT_Select(ByVal ElementID As Long, ByVal Arg1 As Long, ByVal Arg2 As Long)
    On Error GoTo Fin
    If Selection.Name = "Series1" Then
        Application.Goto ActiveWorkbook.Sheets("Sheet2").Range("A1")
    End If
Fin:
End Sub

Upvotes: 0

Related Questions