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

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

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

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

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

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

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

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

创建触发类

这里,我们不再像《一起学Excel专业开发26:使用类模块创建对象5》中那样,在CCells类模块中引发ChangeColor事件,而是创建一个触发类模块来取代其引发事件。这里将创建4个触发类的实例,分别对应于4种不同的单元格类型,同时为每个Cell对象分配一个适当的实例,这意味着每个Cell对象只能接收一种消息。

此外,在使用触发类后,可以删除对对象相互引用的管理。

下面是新创建的CTypeTrigger类模块中的代码。在VBE中,插入一个类模块,将其名称修改为CTypeTrigger,输入以下代码:

'声明事件
Public Event ChangeColor(bColorOn AsBoolean)
 
Public Sub Highlight()
   RaiseEvent ChangeColor(True)
End Sub
 
Public Sub UnHighlight()
   RaiseEvent ChangeColor(False)
End Sub

修改CCell类模块代码,使之能捕获由CTypeTrigger类所引发的ChangeColor事件,其中对象的ChangeColor事件过程根据bColorOn的值来决定是执行Highlight方法还是UnHighlight方法。修改后的CCell类模块代码如下:

'声明模块变量
Private muCellType As anlCellType
Private mrngCell As Excel.Range
Private WithEvents mclsTypeTrigger AsCTypeTrigger
 
'为属性赋值
Property Set TypeTrigger(clsTrigger AsCTypeTrigger)
   Set mclsTypeTrigger = clsTrigger
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
 
'捕获CTypeTrigger对象的ChangeColor事件
Private Sub mclsTypeTrigger_ChangeColor(bColorOn As Boolean)
   If bColorOn Then
       Highlight
   Else
       UnHighlight
   End If
End Sub

对CCells类模块代码进行修改,其中声明了一个名为maclsTriggers的数组变量,用于存放CTypeTrigger类的实例,Initialize事件用于重新设置数组变量maclsTriggers的大小,以匹配单元格类型数,并且使用For Each循环将CTypeTrigger类的实例分配给数组中的每一元素。Add方法根据单元格类型将相应的maclsTriggers实例分配给各Cell对象,这样每个Cell对象都能接收到应用自已单元格类型的消息。修改后的CCells类模块代码如下:

'创建枚举常量
Public Enum anlCellType
   anlCellTypeEmpty
   anlCellTypeLabel
   anlCellTypeConstant
   anlCellTypeFormula
End Enum
 
'声明集合对象
Private mcolCells As Collection
 
'声明模块级事件处理变量
Private WithEvents mwksWorksheet As Excel.Worksheet
 
'声明数组变量
Private maclsTriggers() As CTypeTrigger
 
'添加新属性,引用包含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()
   Dim uCellType As anlCellType
   Set mcolCells = New Collection
   
    '初始化数组
    '一个元素代表一种单元格类型
   ReDim maclsTriggers(anlCellTypeEmpty To anlCellTypeFormula)
   For uCellType = anlCellTypeEmpty To anlCellTypeFormula
       Set maclsTriggers(uCellType) = New CTypeTrigger
   Next uCellType
End Sub
 
'添加新的Cell对象到Cells集合并分析其类型
Public Sub Add(ByRef rngCell As Range)
   Dim clsCell As CCell
   Set clsCell = New CCell
   Set clsCell.Cell = rngCell
   clsCell.Analyze
   Set clsCell.TypeTrigger = maclsTriggers(clsCell.CellType)
   mcolCells.Add Item:=clsCell, Key:=rngCell.Address
End Sub
 
'根据单元格值类型添加背景色
Public Sub Highlight(ByVal uCellType AsanlCellType)
   maclsTriggers(uCellType).Highlight
End Sub
 
'取消单元格值类型相应的背景色
Public Sub UnHighlight(ByVal uCellType AsanlCellType)
   maclsTriggers(uCellType).UnHighlight
End Sub
 
'捕获双击工作表单元格事件
Private Sub mwksWorksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   If Not Application.Intersect(Target, mwksWorksheet.UsedRange) Is NothingThen
       Highlight mcolCells(Target.Address).CellType
       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 NothingThen
       UnHighlightmcolCells(Target.Address).CellType
       Cancel = True
   End If
End Sub
 
'单元格内容修改时更新其类型
Private Sub mwksWorksheet_Change(ByValTarget As Range)
   Dim rngCell As Range
   Dim clsCell As CCell
   
   If Not Application.Intersect(Target, mwksWorksheet.UsedRange) Is NothingThen
       For Each rngCell In Target.Cells
            Set clsCell =mcolCells(rngCell.Address)
            clsCell.Analyze
            Set clsCell.TypeTrigger =maclsTriggers(clsCell.CellType)
       Next rngCell
   End If
End Sub

修改标准模块中的CreateCellsCollection过程如下:

Public Sub CreateCellsCollection()
   Dim clsCell As CCell
   Dim rngCell As Range
   
   '创建新的Cells集合
   Set gclsCells = New CCells
   Set gclsCells.Worksheet = ActiveSheet
   
   '对当前工作表中已使用区域中的每个单元格创建Cell对象
   For Each rngCell In Application.ActiveSheet.UsedRange
       gclsCells.Add rngCell
   Next rngCell
End Sub

这样,先运行CreateCellsCollection过程后,在工作表单元格中双击鼠标将会使同类型单元格添加相同的背景色,右击鼠标取消背景色,达到与前面文章中的示例相同的效果。

本文分享自微信公众号 - 完美Excel(excelperfect)

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

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

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

我来说两句

0 条评论
登录 后参与评论

相关文章

  • 完整的一次 HTTP 请求响应过程(二)

    摘要: 原创出处 https://juejin.im/post/5b152061e51d4506a269a34f 「YangAM」欢迎转载,保留摘要,谢谢!

    芋道源码
  • 测试框架实践--TestFixture

    前面几期分享我实现了一个可以并发运行的”框架“, 其实只能叫半成品, 但好歹可以并发运行, 测试用例动态挑选了。那么还少了什么呢?

    iTesting
  • 一小时学会接口测试

    接口测试最近几年越来越流行了,特别是随着微服务的兴起,系统和系统之间,甚至系统内部模块之间的互相调用都开始大量使用接口了(一般采用RESTFUL风格的http调...

    iTesting
  • 自研测试框架ktest介绍(适用于UI和API)

    在自动化测试的过程中,测试框架是我们绕不过去的一个工具,无论你是不需要写代码直接改动数据生成脚本,还是你需要检查测试结果甚至持续集成,测试框架都在发挥它的作用。...

    iTesting
  • 【RPC 专栏】深入理解 RPC 之集群篇

    摘要: 原创出处 https://www.cnkirito.moe/rpc-cluster/ 「老徐」欢迎转载,保留摘要,谢谢!

    芋道源码
  • Python3实现ICMP远控后门(下)之“Boss”出场

    熬到最后一篇了,本系列的Boss要出场了,实现了一个有意思的ICMP后门,暂时使用pyinstaller打包成了一个win32和64版本,如下图所示。

    网络交换FPGA
  • 分布式消息队列 RocketMQ 源码分析 —— RPC 通信(二)

    摘要: 原创出处 https://mp.weixin.qq.com/s/iJww26xFSwEytoz8NjpFRw 「胡宗棠」欢迎转载,保留摘要,谢谢!

    芋道源码
  • 前后端 API 交互如何保证数据安全性?

    摘要: 原创出处 https://juejin.im/post/5b149754f265da6e155d4748 「猿天地」欢迎转载,保留摘要,谢谢!

    芋道源码
  • 测试框架实践--多线程

    前面几次的分享,我从一个数据驱动的实现展开去,先后讨论了什么是数据驱动,如何实现数据驱动,数据驱动在自动化框架里如何应用。 Python数据驱动实践(一)–dd...

    iTesting
  • 分布式消息队列 RocketMQ 源码分析 —— RPC 通信(一)

    摘要: 原创出处 https://mp.weixin.qq.com/s/V_nOevq_2cbrH2_zgOSP-w 「胡宗棠」欢迎转载,保留摘要,谢谢!

    芋道源码

扫码关注云+社区

领取腾讯云代金券