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

'声明事件
Public Event ChangeColor(bColorOn AsBoolean)
 
Public Sub Highlight()
   RaiseEvent ChangeColor(True)
End Sub
 
Public Sub UnHighlight()
   RaiseEvent ChangeColor(False)
End Sub

'声明模块变量
Private muCellType As anlCellType
Private mrngCell As Excel.Range
Private WithEvents mclsTypeTrigger AsCTypeTrigger
 
'为属性赋值
Property Set TypeTrigger(clsTrigger AsCTypeTrigger)
   Set mclsTypeTrigger = clsTrigger
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
 
'捕获CTypeTrigger对象的ChangeColor事件
Private Sub mclsTypeTrigger_ChangeColor(bColorOn As Boolean)
   If bColorOn Then
       Highlight
   Else
       UnHighlight
   End If
End Sub

'创建枚举常量
Public Enum anlCellType
   anlCellTypeEmpty
   anlCellTypeLabel
   anlCellTypeConstant
   anlCellTypeFormula
End 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 = 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()
   Dim uCellType As anlCellType
   Set mcolCells = New Collection
   
    '初始化数组
    '一个元素代表一种单元格类型
   ReDim maclsTriggers(anlCellTypeEmpty To anlCellTypeFormula)
   For uCellType = anlCellTypeEmpty To anlCellTypeFormula
       Set maclsTriggers(uCellType) = New CTypeTrigger
   Next uCellType
End 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.Address
End Sub
 
'根据单元格值类型添加背景色
Public Sub Highlight(ByVal uCellType AsanlCellType)
   maclsTriggers(uCellType).Highlight
End Sub
 
'取消单元格值类型相应的背景色
Public Sub UnHighlight(ByVal uCellType AsanlCellType)
   maclsTriggers(uCellType).UnHighlight
End 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 If
End 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 If
End 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 If
End Sub

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