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

'创建枚举常量
Public Enum anlCellType
   anlCellTypeEmpty
   anlCellTypeLabel
   anlCellTypeConstant
   anlCellTypeFormula
End 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 = 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()
   Set mcolCells = New Collection
End 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.Address
End 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 If
End 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 If
End 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 If
End 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 clsCell
End 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 clsCell
End Sub
 
Public Sub Terminate()
    Dim clsCell As CCell
    '释放所有子类
   For Each clsCell In mcolCells
       clsCell.Terminate
   Next clsCell
    '释放集合对象
   Set mcolCells = Nothing
End Sub

'声明模块变量
Private muCellType As anlCellType
Private mrngCell As Excel.Range
Private WithEvents mclsParent As CCells
 
'引用Cells集合对象
Property Set Parent(ByRef clsCells AsCCells)
   Set mclsParent = clsCells
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
 
'捕获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 If
End Sub
 
Public Sub Terminate()
   Set mclsParent = Nothing
End Sub

Set gclsCells = Nothing

Public Sub Terminate()
   Set mclsParent = Nothing
End Sub

Public Sub Terminate()
   Dim clsCell As CCell
    '释放所有子类
   For Each clsCell In mcolCells
       clsCell.Terminate
   Next clsCell
    '释放集合对象
   Set mcolCells = Nothing
End Sub

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 rngCell
End Sub