如何通过点击Excel数据透视图表元素获取对应值（VBA实现）

我需要通过VBA实现点击Excel数据透视图表中的特定格式元素（如UQZCJQJPVL这类10位字母数字组合），并获取其对应值。目前已能在切换到目标工作表时，通过正则匹配提取符合格式的标签内容，但尝试使用BeforeDoubleClick、MouseDown等事件均未成功，求可行的实现方法。

现有代码：

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim cht As ChartObject
    Dim seriesCollection As SeriesCollection
    Dim series As Series
    Dim point As Point
    Dim i As Integer
    Dim regex As Object
    Dim match As Object

    ' 创建正则表达式对象
    Set regex = CreateObject("VBScript.RegExp")
    regex.Pattern = "[A-Z0-9]{10}" ' 定义匹配10位字母数字的规则

    ' 遍历当前工作表所有图表
    For Each cht In Sh.ChartObjects
        Debug.Print "Chart data: " & cht.Name

        ' 获取图表的系列集合
        Set seriesCollection = cht.Chart.SeriesCollection

        ' 遍历所有系列
        For Each series In seriesCollection
            Debug.Print "Series: " & series.Name

            ' 打印符合格式的分类标签
            If Not IsEmpty(series.XValues) Then
                For i = 1 To series.Points.Count
                    ' 用正则检查分类标签格式
                    Set match = regex.Execute(series.XValues(i))
                    If match.Count > 0 Then
                        Debug.Print "Category value of point " & i & ": " & match(0)
                    End If
                Next i
            End If
        Next series

        Debug.Print vbCrLf
    Next cht
End Sub

可行实现步骤 #

ChartObject的鼠标事件无法直接在工作表/工作簿模块中捕获，必须通过类模块绑定事件的方式实现，具体步骤如下：

1. 创建类模块

   • 插入新的类模块，命名为ChartEvents（类名请勿包含空格）
   • 在类模块中添加以下代码：

     Public WithEvents chtObj As ChartObject
     
     Private Sub chtObj_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Long, ByVal y As Long)
         Dim cht As Chart
         Dim elementID As Long, arg1 As Long, arg2 As Long
         Dim categoryName As String
         Dim regex As Object, match As Object
         
         Set cht = chtObj.Chart
         ' 获取点击位置对应的图表元素信息
         cht.GetChartElement x, y, elementID, arg1, arg2
         
         ' 判断是否点击到数据点或数据标签
         If (elementID = xlSeries Or elementID = xlDataLabel) And arg1 > 0 And arg2 > 0 Then
             ' 获取点击数据点的分类名称
             categoryName = cht.SeriesCollection(arg1).XValues(arg2)
             
             ' 正则匹配目标格式内容
             Set regex = CreateObject("VBScript.RegExp")
             regex.Pattern = "[A-Z0-9]{10}"
             Set match = regex.Execute(categoryName)
             
             If match.Count > 0 Then
                 ' 此处可替换为自定义处理逻辑，如写入单元格或弹窗显示
                 MsgBox "点击的目标值：" & match(0)
             End If
         End If
     End Sub
     

2. 绑定图表事件

   • 打开ThisWorkbook模块，添加以下代码，实现切换工作表时自动绑定所有图表的事件：

     Dim chartEventHandlers As Collection
     
     Private Sub Workbook_SheetActivate(ByVal Sh As Object)
         Dim chtObj As ChartObject
         Dim chtHandler As ChartEvents
         
         ' 清空旧的事件绑定
         Set chartEventHandlers = New Collection
         
         ' 遍历当前工作表所有图表，绑定事件处理器
         For Each chtObj In Sh.ChartObjects
             Set chtHandler = New ChartEvents
             Set chtHandler.chtObj = chtObj
             chartEventHandlers.Add chtHandler
         Next chtObj
     End Sub
     

关键说明 #

• 使用GetChartElement方法可精准获取点击位置对应的图表元素类型、系列索引和数据点索引
• 通过类模块的WithEvents变量，才能捕获ChartObject的鼠标事件（MouseUp比MouseDown更稳定，可避免拖拽误触发）
• 代码保留了原有的正则匹配逻辑，确保仅处理符合[A-Z0-9]{10}格式的元素

内容的提问来源于stack exchange，提问作者Chris Nuvoli