excel专业开发_一起学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   anlCellTypeFormulaEnd 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 = 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()   Set mcolCells = New CollectionEnd 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.AddressEnd 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 IfEnd 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 IfEnd 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 IfEnd 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 clsCellEnd 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 clsCellEnd Sub Public Sub Terminate()    Dim clsCell As CCell    '释放所有子类   For Each clsCell In mcolCells       clsCell.Terminate   Next clsCell    '释放集合对象   Set mcolCells = NothingEnd 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 anlCellTypePrivate mrngCell As Excel.RangePrivate WithEvents mclsParent As CCells '引用Cells集合对象Property Set Parent(ByRef clsCells AsCCells)   Set mclsParent = clsCellsEnd 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 '捕获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 IfEnd Sub Public Sub Terminate()   Set mclsParent = NothingEnd 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 rngCellEnd Sub

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