Question

我使用以下代码向图表添加超链接，将其链接到不同的工作表：

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

但是，这会创建一个在单击整个图表时激活的链接。饼图有4个段（每个段与不同的系列相关），我希望每个段链接到不同的工作表。因此，第一个段将转到Sheet2，第二个段转到Sheet3，依此类推。

有没有办法将锚点添加到每个单独的细分，而不是整个图表？

Answer 1

我花了12个小时，因为我有同样的问题。以下是我从一个全新的Excel工作簿开始工作的方式：

1）组成饼图的数据

Name    Score
Art     20
Bob     15
Joe     19
Tim     5

2）插入饼图，使其在同一工作表中显示为对象

3）右键单击＆＃34;查看代码＆＃34;在Sheet1选项卡上。

4）插入＆＃34;类模块＆＃34; - 可能被称为＆＃34; Class1＆＃34;默认情况下

5）将以下代码粘贴到类模块中：

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）上述代码只有在我们能够擅长处理＆＃34; chartobjects＆＃34; as＆＃34; chart＆＃34;。要做到这一点：打开代码＆＃34;本工作手册＆＃34;使用视图代码。 7）粘贴以下内容：

Dim ChartObjectClass As New Class1

Private Sub Workbook_Open（）设置ChartObjectClass.ChartObject = Worksheets（1）.ChartObjects（1）.Chart 结束子

8）类模块中的编码被装配到名为＆＃34; Series Art Detail＆＃34;，＆＃34; Series Joe Detail＆＃34;，＆＃34; Series Bob Detail＆＃34;和系列＆＃34; Tim Detail＆＃34; 创建这4个选项卡。饼图切片到制表符的映射位于类代码的底线附近。

9）测试并享受！

Answer 2

使用以下代码：

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

Excel图表超链接

2 个答案: