学习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过程后,在工作表单元格中双击鼠标将会使同类型单元格添加相同的背景色,右击鼠标取消背景色,达到与前面文章中的示例相同的效果。