在工作表中选择多个图表时捕获事件

Question

我想在工作表中选择多个图表时捕捉事件。他们是在 Excel VBA 中实现这一目标的事件处理程序吗？

我已经设法使用类 AppEvents 捕获应用程序级别的事件，并使用类 ChartEvents 捕获工作表中的所有图表。 事件捕获器以 AppEventsStart 启动，它打开表单 ufEvents。该表单显示选定的对象名称或选定的范围地址，并将所有事件记录在一个列表框中。事件捕获器以 AppEventsEnd 或关闭表单结束。

代码模块mEvents

Public App As AppEvents
Public Cht As New ChartEvents
Public Chts() As New ChartEvents

'*** Application *********************

'*** Activate Application event catcher
Public Sub AppEventsStart()
    Set App = New AppEvents
    ChartEventsStart
    Load ufEvents
    ufEvents.Show vbModeless
End Sub

'*** Deactivate Application event catcher
Public Sub AppEventsEnd()
    Set App = Nothing
    ChartEventsEnd
    Unload ufEvents
End Sub

'*** Charts *********************

'*** Activate Chart event catcher
Sub ChartEventsStart()
    Application.EnableEvents = True

    Dim chtObj As ChartObject
    Dim i As Integer

    'only initialize when there are charts in sheet
    If ActiveSheet.ChartObjects.Count > 0 Then
        ReDim Chts(ActiveSheet.ChartObjects.Count - 1)

        i = 0
        For Each chtObj In ActiveSheet.ChartObjects            
            Set Chts(i).EventChart = chtObj.Chart
            i = i + 1
        Next chtObj
    End If
End Sub

'*** Deactivate Chart event catcher
Sub ChartEventsEnd()
    Dim i As Integer

    'single chart in sheet
    On Error Resume Next
    Set Cht.EventChart = Nothing

    'multiple charts in sheet
    For i = 0 To UBound(Chts)        
        Set Chts(i).EventChart = Nothing
    Next i
    On Error GoTo 0
End Sub

类AppEvents

Private WithEvents EventApp As Excel.Application

'*** Starting application event catcher
Private Sub Class_Initialize()
    Set EventApp = ActiveWorkbook.Application
End Sub

'*** When activating a sheet
Private Sub EventApp_SheetActivate(ByVal sh As Object)
    ChartEventsStart
    ufEvents.Update "Activated sheet " & sh.Name
End Sub

'*** When deactivating a sheet
Private Sub EventApp_SheetDeactivate(ByVal sh As Object)
    ChartEventsEnd
    ufEvents.Update "Dectivated sheet " & sh.Name
End Sub

'*** When changing tha range selection in a sheet
Private Sub EventApp_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
    ufEvents.Update "Changed selection in sheet " & sh.Name
End Sub

'*** When changing the content in a sheet
Private Sub EventApp_SheetChange(ByVal sh As Object, ByVal Target As Range)
    ufEvents.Update "Changed sheet " & sh.Name
End Sub

类 ChartEvents

Public WithEvents EventChart As Chart

'*** When activating a chart
Private Sub EventChart_Activate()
    ufEvents.Update "Activated chart " & ActiveChart.Parent.Name
End Sub

'*** When deactivating a chart
Private Sub EventChart_Deactivate()
    ufEvents.Update "Deactivated chart " & EventChart.Parent.Name
End Sub

'*** When clicking the mouse on a chart
Private Sub EventChart_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
    ufEvents.Update "Mouse down on chart " & EventChart.Parent.Name
End Sub

'*** When changing the selection in a chart
Private Sub EventChart_Select(ByVal ElementID As Long, ByVal Arg1 As Long, ByVal Arg2 As Long)
    ufEvents.Update "Changed selection in chart " & ActiveChart.Parent.Name
End Sub

用户表单ufEvents

'*** Update form with last event and and selected object name
Public Sub Update(Optional ByVal lastEvent As String = vbNullString)

    'add and last event in listbox and select it
    If lastEvent <> vbNullString Then
        lbxLog.AddItem lastEvent
        lbxLog.ListIndex = lbxLog.ListCount - 1
    End If

    'display selected range address
    If TypeName(Selection) = "Range" Then
        txtSelection.Value = "Range " & Selection.Address

    'display selected object name
    Else
        txtSelection.Value = TypeName(Selection)
    End If
End Sub

'*** End event catcher when closing form
Private Sub UserForm_Terminate()
    AppEventsEnd
End Sub

When several charts are selected the statement TypeName(Selection) returns DrawingObjects, thus I know when I have selected multiple charts.

我希望 _Activate 或 _MouseDown 在使用 Ctrl 和 鼠标左键选择至少一个图表时执行强>。这不会发生。事实上，当至少选择两个图表时，不会再捕获任何事件。

我尝试创建一个类似于 ChartEvents 的类，例如带有

的形状

Public WithEvents obj As Shape

很遗憾，这不起作用。

当更改多个图表的选择时，Excel VBA 中是否有要捕获的事件处理程序？

提前感谢您的支持！ 以马内利

Answer 1

我认为没有用于更改多个图表选择的事件处理程序，因为看起来 Excel 在选择多个图表后进入了编辑模式。

您可以（作为一种解决方法并在适合您的目的时）添加几行代码，以确保只有 1 个图表被激活/选择。

如下更改您的 EventChart_Deactivate； （将 visible 属性设置为 False 并返回 True 会取消选择它）

   Private Sub EventChart_Deactivate()
    ActiveSheet.ChartObjects(EventChart.Parent.Name).Visible = False
    ActiveSheet.ChartObjects(EventChart.Parent.Name).Visible = True
    ufEvents.Update "Deactivated chart " & EventChart.Parent.Name
    If Not ActiveChart Is Nothing Then ActiveSheet.ChartObjects(ActiveChart.Parent.Name).Activate 
    End Sub