VBA - 单击饼图的不同切片以运行不同的宏

如何解决VBA - 单击饼图的不同切片以运行不同的宏

不确定是否可以使用 VBA，但我想将饼图的每个部分用作按钮来运行四个不同的宏。

此外，每次值更改时都会重新创建饼图（如下所示的代码），因此切片的大小不固定。因此，我不认为我可以在切片顶部放置一个类似的形状并为其分配一个宏。

Public Sub CreatePieChart()

Dim ws As Worksheet

Dim ch_shape As Shape
Dim lab As DataLabel
Dim x As Long,y As Long,w As Long,h As Long
Dim circ As Shape

Set ws = ThisWorkbook.Worksheets("Sheet1")

Set ch_shape = ws.Shapes.AddChart2

With ch_shape.Chart
    With .ChartArea
        .Format.Fill.ForeColor.RGB = RGB(244,244,244)
        .Height = 300
        .Width = 450
        
        .Left = 0
        .Top = 350
        
    End With
    
    .ChartType = xlPie
    .SetSourceData ws.Range("D14:E17")
    .HasTitle = False
    .HasLegend = False
    .ApplyDataLabels xlDataLabelsShowLabel,True,vbLf
    
    With .FullSeriesCollection(1).DataLabels
        .Position = xlLabelPositionOutsideEnd
        .NumberFormat = "0.0%"
    End With

End With

End Sub

解决方法

您可以将其制作成图表并使用 Chart_select 事件。

选择您的数据范围并按 F11。
将图表类型更改为圆形。

打开 VBA 编辑器并打开图表代码并粘贴以下内容：

Private Sub Chart_Select(ByVal ElementID As Long,ByVal Arg1 As Long,ByVal Arg2 As Long)
    Debug.Print ElementID
    Debug.Print Arg1
    Debug.Print Arg2
    Debug.Print ""
End Sub

这三个参数告诉你你按下了图表的哪个部分。
当我点击黄色较大的图表对象时，我得到：

 3 
 1 
 4 

还有蓝色：

3
1
1

我没有做更多的调试，但我认为 3 是图表区域，因为如果我点击白色区域，我会得到 2,0。
不管怎样，我想你会找到处理你的工作案例的方法。

找到一个页面，其中包含有关图表事件的一些信息 https://peltiertech.com/chart-events-microsoft-excel/

,

请尝试下一个方法：

1. 插入一个类模块并将其命名为“ChartEvClass”。复制其模块中的下一个代码：

Option Explicit

Public WithEvents EvtChart As Chart

Private Sub EvtChart_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 arrDL,i As Long
    
    ReDim arrDL(1 To ActiveChart.SeriesCollection(1).DataLabels.count)
    For i = 1 To ActiveChart.SeriesCollection(1).DataLabels.count
        arrDL(i) = Split(ActiveChart.SeriesCollection(1).DataLabels(i).Text,vbLf)(0)
    Next i
    With ActiveChart
        .GetChartElement x,y,elementId,arg1,arg2
        Call DoSomething(Application.Index(arrDL,arg2))        
    End With
End Sub

2. 在标准模块（声明区域）之上，创建一个 Private 变量：

Private clsEventCharts() As New ChartEvClass

3. 在同一模块中，复制下一个过程（例如，可以由事件 Sheet_Activate 调用）：

Sub ActivateChartsEvent()
  If ActiveSheet.ChartObjects.count > 0 Then
        ReDim clsEventCharts(1 To ActiveSheet.ChartObjects.count)
        Dim chtObj As ChartObject,i As Long: i = 1

        For Each chtObj In ActiveSheet.ChartObjects
            Set clsEventCharts(i).EvtChart = chtObj.Chart
            i = i + 1
        Next
    End If
End Sub

上述 Sub 可能会将事件分配给所有现有图表。运行它并尝试通过单击图表切片进行播放。该事件将返回切片标签...

4. 也复制下一个代码。可以用来根据返回的标签运行一些东西：

Sub DoSomething(strLabel As String)
    MsgBox strLabel
    'use the label to run whatever you need...
End Sub

类代码是动态的，它应该返回标签存在的数量。

请测试并发送一些反馈。