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

fanjy

发布于 2019-11-13 04:55:48

77000

代码可运行

文章被收录于专栏：完美Excel完美Excel

运行总次数：0

代码可运行

在阅读本文之前，建议先阅读下面3篇文章：

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

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

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

响应事件

类模块能够对事件进行响应，这也是它的一个强大的功能。

下面，我们接着前面文章中的示例进一步扩展，添加如下功能：

1.双击工作表中某单元格时，高亮显示与该单元格同类型的所有单元格。

2.右击工作表中某高亮显示的单元格时，取消所有同类型单元格的高亮显示。

3.当工作表中单元格被修改时，对应的CCell对象能自动更新。

要获取与对象相关的事件，一般有两个步骤：

1.在类模块中使用WithEvents声明一个对象类型的变量。

2.给该变量指定某对象的引用。

在CCells类模块的顶部，添加一条声明语句：

Private WithEvents mwksWorksheet AsExcel.Worksheet

此时，可以在该类模块的代码窗口顶部左上方的下拉列表中选择mwksWorksheet，单击其右上方的下拉列表，可以看到所捕获的事件，如下图1所示。

图1

我们选添加一个名为Worksheet的新属性，然后添加BeforeDoubleClick事件、BeforeRightClick事件和Change事件，以实现我们想要的功能。

在CCells类模块中新添加的代码如下：

'声明模块级事件处理变量
Private WithEvents mwksWorksheet As Excel.Worksheet
 
'添加新属性
Property Set Worksheet(wks As Excel.Worksheet)
   Set mwksWorksheet = wks
End Property
 
'捕获双击工作表单元格事件
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
       UnHighlight mcolCells(Target.Address).CellType
       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 Nothing Then
       For Each rngCell In Target.Cells
            mcolCells(rngCell.Address).Analyze
       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