Reputation: 927
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
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
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