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

学习Excel技术，关注微信公众号：

excelperfect

在阅读本文之前，建议先阅读下面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 anlCellTypePrivate mrngCell As Excel.RangePrivate WithEvents mclsTypeTrigger AsCTypeTrigger '为属性赋值Property Set TypeTrigger(clsTrigger AsCTypeTrigger)   Set mclsTypeTrigger = clsTriggerEnd Property '为属性赋值Property Set Cell(ByRef rngCell AsExcel.Range)   Set mrngCell = rngCellEnd Property '获取属性值Property Get Cell() As Excel.Range   Set Cell = mrngCellEnd Property '获取属性值Property Get CellType() As anlCellType   CellType = muCellTypeEnd Property '获取属性值'转换枚举常量为文本Property Get DescriptiveCellType() AsString   Select Case muCellType       Case anlCellTypeEmpty            DescriptiveCellType = "空"       Case anlCellTypeLabel            DescriptiveCellType = "标签"       Case anlCellTypeConstant            DescriptiveCellType = "常量"       Case anlCellTypeFormula            DescriptiveCellType = "公式"   End SelectEnd 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 IfEnd Sub '添加背景色Public Sub Highlight()   Cell.Interior.ColorIndex = Choose(muCellType + 1, 5, 6, 7, 8)End Sub '取消背景色Public Sub UnHighlight()   Cell.Interior.ColorIndex = xlNoneEnd Sub '捕获CTypeTrigger对象的ChangeColor事件Private Sub mclsTypeTrigger_ChangeColor(bColorOn As Boolean)   If bColorOn Then       Highlight   Else       UnHighlight   End IfEnd Sub

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

'创建枚举常量Public Enum anlCellType   anlCellTypeEmpty   anlCellTypeLabel   anlCellTypeConstant   anlCellTypeFormulaEnd 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 = wksEnd Property '返回集合成员数Property Get Count() As Long   Count = mcolCells.CountEnd 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 uCellTypeEnd 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.AddressEnd Sub '根据单元格值类型添加背景色Public Sub Highlight(ByVal uCellType AsanlCellType)   maclsTriggers(uCellType).HighlightEnd Sub '取消单元格值类型相应的背景色Public Sub UnHighlight(ByVal uCellType AsanlCellType)   maclsTriggers(uCellType).UnHighlightEnd 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 IfEnd 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 IfEnd 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 IfEnd 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 rngCellEnd Sub

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