专栏首页完美Excel一起学Excel专业开发26:使用类模块创建对象5

一起学Excel专业开发26:使用类模块创建对象5

学习Excel技术,关注微信公众号:

excelperfect

在阅读本文之前,建议先阅读下面4篇文章:

1.一起学Excel专业开发22:使用类模块创建对象1

2.一起学Excel专业开发23:使用类模块创建对象2

3.一起学Excel专业开发24:使用类模块创建对象3

4.一起学Excel专业开发25:使用类模块创建对象4

引发事件

类模块具有引发事件的能力,这也是它的另一个强大的功能。我们可以定义自已的事件,并在代码中引发这个事件,其他类模块也可以捕获这些自定义的事件并作出相应的响应。

下面的示例演示了Cells对象引发事件,而Cell对象捕获事件并进行响应。在类模块中引发事件分两步:

1.在类模块中声明事件

2.使用RaiseEvent引发该事件

下面是修改后的CCells类模块中的代码:

'创建枚举常量
Public Enum anlCellType
   anlCellTypeEmpty
   anlCellTypeLabel
   anlCellTypeConstant
   anlCellTypeFormula
End Enum
 
'声明集合对象
Private mcolCells As Collection
 
'声明模块级事件处理变量
Private WithEvents mwksWorksheet As Excel.Worksheet
 
'对事件进行声明
Event ChangeColor(uCellType AsanlCellType, bColorOn As Boolean)
 
'添加新属性,引用包含Cell对象的工作表
Property Set Worksheet(wks As Excel.Worksheet)
   Set mwksWorksheet = wks
End Property
 
'返回集合成员数
Property Get Count() As Long
   Count = mcolCells.Count
End Property
 
'通过索引值或键值从Cells集合中返回元素项
Property Get Item(ByVal vID As Variant) As CCell
   Set Item = mcolCells(vID)
End Property
 
'使For Each循环能够遍历集合
Public Function NewEnum() As IUnknown
   Set NewEnum = mcolCells.[_NewEnum]
End Function
 
'类初始化时创建新集合
Private Sub Class_Initialize()
   Set mcolCells = New Collection
End Sub
 
'添加新的Cell对象到Cells集合并分析其类型
Public Sub Add(ByRef rngCell As Range)
   Dim clsCell As CCell
   Set clsCell = New CCell
   Set clsCell.Cell = rngCell
   Set clsCell.Parent = Me
   clsCell.Analyze
   mcolCells.Add Item:=clsCell, Key:=rngCell.Address
End Sub
 
'捕获双击工作表单元格事件
Private Sub mwksWorksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   If Not Application.Intersect(Target, mwksWorksheet.UsedRange) Is Nothing Then
       RaiseEvent ChangeColor(mcolCells(Target.Address).CellType, True)
       Cancel = True
   End If
End Sub
 
'捕获右击工作表单元格事件
Private Sub mwksWorksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
   If Not Application.Intersect(Target, mwksWorksheet.UsedRange) Is Nothing Then
       RaiseEvent ChangeColor(mcolCells(Target.Address).CellType, False)
       Cancel = True
   End If
End Sub
 
'捕获工作表单元格内容修改事件
Private Sub mwksWorksheet_Change(ByValTarget As Range)
   Dim rngCell As Range
   If Not Application.Intersect(Target, mwksWorksheet.UsedRange) Is NothingThen
       For Each rngCell In Target.Cells
            mcolCells(rngCell.Address).Analyze
       Next rngCell
   End If
End Sub
 
'根据单元格值类型添加背景色
Public Sub Highlight(ByVal uCellType AsanlCellType)
   Dim clsCell As CCell
   For Each clsCell In mcolCells
       If clsCell.CellType = uCellType Then
            clsCell.Highlight
       End If
   Next clsCell
End Sub
 
'取消单元格值类型相应的背景色
Public Sub UnHighlight(ByVal uCellType AsanlCellType)
   Dim clsCell As CCell
   For Each clsCell In mcolCells
       If clsCell.CellType = uCellType Then
            clsCell.UnHighlight
       End If
   Next clsCell
End Sub
 
Public Sub Terminate()
    Dim clsCell As CCell
    '释放所有子类
   For Each clsCell In mcolCells
       clsCell.Terminate
   Next clsCell
    '释放集合对象
   Set mcolCells = Nothing
End Sub

因为在CCells类和CCell类之间显示地建立了父子关系现在,所以枚举型常量anlCellType的声明在父类集合的类模块CCells中。

在CCells类中,声明了一个名为ChangeColor的事件,包含两个参数:第一个参数uCellType接受需要进行更改的单元格类型,第二个参数bColorOn指定是否进行颜色转换。

对BeforeDoubleClick事件和BeforeRightClick事件进行了修改,使之能够引发新的事件,并传递给ChangeColor事件目标单元格的类型和指定颜色开或关的布尔值。

对Add方法进行了更新,用来设置Cell对象的新属性Parent。该属性用于保存对Cells对象的引用,从而使Cells对象和Cell对象建立父子关系。

使用《一起学Excel专业开发25:使用类模块创建对象4》中介绍的方法,在CCell类模块中捕获Cells对象所引发的事件。修改后的CCell类模块代码如下:

'声明模块变量
Private muCellType As anlCellType
Private mrngCell As Excel.Range
Private WithEvents mclsParent As CCells
 
'引用Cells集合对象
Property Set Parent(ByRef clsCells AsCCells)
   Set mclsParent = clsCells
End Property
 
'为属性赋值
Property Set Cell(ByRef rngCell AsExcel.Range)
   Set mrngCell = rngCell
End Property
 
'获取属性值
Property Get Cell() As Excel.Range
   Set Cell = mrngCell
End Property
 
'获取属性值
Property Get CellType() As anlCellType
   CellType = muCellType
End Property
 
'获取属性值
'转换枚举常量为文本
Property Get DescriptiveCellType() AsString
   Select Case muCellType
       Case anlCellTypeEmpty
            DescriptiveCellType = "空"
       Case anlCellTypeLabel
            DescriptiveCellType = "标签"
       Case anlCellTypeConstant
            DescriptiveCellType = "常量"
       Case anlCellTypeFormula
            DescriptiveCellType = "公式"
   End Select
End Property
 
'分析指定单元格
Public Sub Analyze()
   If IsEmpty(mrngCell) Then
       muCellType = anlCellTypeEmpty
   ElseIf mrngCell.HasFormula Then
       muCellType = anlCellTypeFormula
   ElseIf IsNumeric(mrngCell.Formula) Then
       muCellType = anlCellTypeConstant
   Else
       muCellType = anlCellTypeLabel
   End If
End Sub
 
'添加背景色
Public Sub Highlight()
   Cell.Interior.ColorIndex = Choose(muCellType + 1, 5, 6, 7, 8)
End Sub
 
'取消背景色
Public Sub UnHighlight()
   Cell.Interior.ColorIndex = xlNone
End Sub
 
'捕获Cells对象的ChangeColor事件
Private Sub mclsParent_ChangeColor(uCellType As anlCellType, bColorOn As Boolean)
   If Me.CellType = uCellType Then
       If bColorOn Then
            Highlight
       Else
            UnHighlight
       End If
   End If
End Sub
 
Public Sub Terminate()
   Set mclsParent = Nothing
End Sub

在CCell类模块中,使用WithEvents声明了一个模块级的变量mclsParent,用于代表CCells类的实例,在Parent属性过程中,将一个Cells对象赋值给变量mclsParent。这样,当Cells对象引发ChangeColor事件时,Cell对象就能够捕获该事件,并根据单元格的类型进行相应的响应,如下图1所示。

图1

注意,为了更有效地避免内存泄漏,当不需要某个对象时,建议将其显示地设置为空,尽量不要依赖VBA来完成这些操作:

Set gclsCells = Nothing

此外,当两个对象中分别保存着对彼此的引用时,即便将它们设置为新值或空值,系统也不会再回收它们的内存空间。其中一种解决方法是:在删除对象之前,将它与另一对象之间的相互引用关系删除。可以在类中加入新方Terminate来解决,例如:

在CCell类模块中的Terminate方法:

Public Sub Terminate()
   Set mclsParent = Nothing
End Sub

在CCells类模块中的Terminate方法:

Public Sub Terminate()
   Dim clsCell As CCell
    '释放所有子类
   For Each clsCell In mcolCells
       clsCell.Terminate
   Next clsCell
    '释放集合对象
   Set mcolCells = Nothing
End Sub

修改后的CreateCellsCollection过程:

Public Sub CreateCellsCollection()
    Dim clsCell As CCell
   Dim rngCell As Range
   
    '清除任意已存在的Cells集合的实例
   If Not gclsCells Is Nothing Then
       gclsCells.Terminate
       Set gclsCells = Nothing
   End If
   
    '创建新的Cells集合
   Set gclsCells = New CCells
   Set gclsCells.Worksheet = ActiveSheet
   
    '对当前工作表中已使用区域中的每个单元格创建Cell对象
   For Each rngCell In Application.ActiveSheet.UsedRange
       gclsCells.Add rngCell
   Next rngCell
End Sub

在上面的代码中,如果变量gclsCells所引用的实例存在,则先执行其Terminate方法,遍历集合中所有对象,并执行它们各自的Terminate方法,最后,将gclsCells对象实例设置为空。

本文分享自微信公众号 - 完美Excel(excelperfect),作者:fanjy

原文出处及转载信息见文内详细说明,如有侵权,请联系 yunjia_community@tencent.com 删除。

原始发表时间:2019-11-13

本文参与腾讯云自媒体分享计划,欢迎正在阅读的你也加入,一起分享。

我来说两句

0 条评论
登录 后参与评论

相关文章

  • 一起学Excel专业开发27:使用类模块创建对象6

    这里,我们不再像《一起学Excel专业开发26:使用类模块创建对象5》中那样,在CCells类模块中引发ChangeColor事件,而是创建一个触发类模块来取代...

    fanjy
  • Excel应用实践12:在用户窗体中添加、查找和编辑数据记录

    在Excel中,我已经创建了一个输入数据的用户窗体,用于在工作记录工作表中添加新数据记录。最近,老板提出了新的需求,要通过该用户窗体能够编辑数据记录,增强其功能...

    fanjy
  • Excel实战技巧71: 自动响应消息框信息

    运行test过程,将打开C盘中名为test.xlsm的工作簿,并弹出如下图1所示的消息框。

    fanjy
  • 从密度矩阵产生自然轨道-理论篇

      对于一个单或多行列式波函数方法(例如RHF, MP2, CCSD, CASCI, CASSCF等等),可将电荷密度(charge density)

    用户7592569
  • VB.NET Excel操作类(获取工作簿列表和工作表列表及工作表对象)

    巴西_prince
  • 远程触发Jenkins的Pipeline任务的并发问题处理

    本文是《远程触发Jenkins的Pipeline任务》的续篇,上一篇实战了通过Http请求远程触发指定的Jenkins任务,并且将参数传递给Jenkins任务的...

    程序员欣宸
  • 医疗研究人员探索无人机及时运送器官的可行性

    当需要器官移植的患者与捐献者匹配时,每一秒都至关重要。从供体移除器官,并将其置于受体之外的较长等待时间,可能会导致移植后器官功能变差。为了最大限度地提高成功率,...

    AiTechYun
  • itchat实现微信好友头像拼接图

    偶然在网上发现itchat这个框架,itchat是一个开源的微信个人号接口,它使python调用微信变得非常简单。看到网上有人发自己微信好友的头像拼接图,自己也...

    听城
  • 干货:ToB(SaaS)企业如何寻找可持续、可规模化、可盈利增长模式

    ? 来源 :SaaS随笔  ID:NotesOnSaaS ---- 一般而言,对2C的初创企业来说,在打磨好产品后就有机会迎来爆发式增长。但很多2B的企业会...

    腾讯SaaS加速器
  • 图灵机器人郭家:以语义技术为核心驱动力,让机器更好地理解世界

    导读:2017年12月26日,中国人工智能机器人CEO峰会在深圳举办。图灵机器人联合创始人郭家做了“AI之多模态语义”的主题分享。 12月26日,中国人工智能机...

    企鹅号小编

扫码关注云+社区

领取腾讯云代金券