如何利用类模块给所有打开的工作簿定义双击图表的事件程序？

作者：绿色风分类：时间：2022-08-17 浏览：133

楼主
amulee

Q：如何利用类模块给所有打开的工作簿定义双击图表的事件程序？
A：如本例，原工作表中有两个图表，利用类模块对该图表设置了事件程序。类模块MyCht代码：

Public WithEvents Cht As Chart
Private Sub Cht_BeforeDoubleClick(ByVal ElementID As Long, ByVal Arg1 As Long, ByVal Arg2 As Long, Cancel As Boolean)
Cancel = True
myclr1 = 7 '天蓝色
myclr2 = 21
For Each Series In Cht.SeriesCollection '遍历所有的系列
myclr1 = myclr1 + 1 ' 每一次运行自动换色
myclr2 = myclr2 + 1
'给柱形图自动换色
If Series.ChartType = xlColumnClustered Then
For Each pt In Series.Points
pt.Interior.ColorIndex = myclr1
Next pt
End If
'给折线图上颜色
If Series.ChartType = xlLine Then
Series.Border.ColorIndex = myclr2
End If
Next
End Sub

在标准模块中的语句：

Public Chat() As MyCht

在Thisworkbook中的语句：

Private Sub Workbook_Open()
Dim K%
Dim Sht As Worksheet
Dim Cht As ChartObject
For Each Sht In Worksheets
For Each Cht In Sht.ChartObjects
K = K + 1
ReDim Preserve Chat(1 To K)
Set Chat(K) = New MyCht
Set Chat(K).Cht = Cht.Chart
Next
Next
End Sub

这一系列的语句实现了打开工作簿即将工作簿中所有的图表进行绑定，使之具备双击时变色的事件。

若将该工作簿定义为加载宏，如何利用类模块使所有打开的工作簿中的图表都具有该事件呢？

对于Application对象，有一个WorkbookOpen事件，当该Application打开工作簿时就执行该事件程序。利用它，可以实现所有打开工作簿都运行上述单个工作簿的事件程序。

添加一个类模块MyApp，代码如下：

Public WithEvents ExlApp As Application
Private K As Long
Private Chat() As MyCht
Private Sub ExlApp_WorkbookOpen(ByVal Wb As Workbook)
Dim Sht As Worksheet
Dim Cht As ChartObject
For Each Sht In Wb.Worksheets
For Each Cht In Sht.ChartObjects
K = K + 1
ReDim Preserve Chat(1 To K)
Set Chat(K) = New MyCht
Set Chat(K).Cht = Cht.Chart
Next
Next
End Sub

将模块中的代码更改如下：

Public NewApp As New MyApp

Thisworkbook中代码更改如下：

Private Sub Workbook_Open()
Set NewApp.ExlApp = ThisWorkbook.Application
End Sub

之后将工作簿保存为加载宏，并加载该工作簿。当该加载宏打开后即绑定当前Excel程序，使该程序具有WorkbookOpen事件程序，当打开其他工作簿时都会执行该程序即使该工作簿中所有的图表具备双击事件。

图表事件.rar

2楼
fx1986112

谢谢lz帮忙，这代码从头到尾都是lz帮忙完成，我只负责提问，哈哈，只是现在我还有个问题，本代码是在thisworkbook的open事件中运行的，所以如果在excel中新添加一张图表的话，是不能立即双击改色的，必须关闭当前工作簿然后再打开才能运行程序，现在我想不用重启直接双击，不知道应该怎么样实现？我用过thisworkbook中的active何sheetactive好像都不行？

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，经与ExcelTip.Net站长Apolloh商议并征得其同意，现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，供有需要的人士查询使用，也慰缅曾经的论坛时代。所示各个帖子的原作者如对版权有异议，可与本人沟通提出，或于本站点留言，我们会尽快处理。在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表