捕获事件实例: 现在,请打开附件“类_4.xlsm”,如果要在Sheet1的A1:A41单元格中,实现双击某一单元格,则与此单元格类型相同的单元格被着色,右击某一单元格,则与此单元格类型相同的单元格去色,该如何处理呢? 我们知道worksheet有BeforeDoubleClick事件,我们现在要做的是捕获Sheet1的BeforeDoubleClick事件,根据前面所讲的,在rngFormatDS类模块的顶部声明变量:Private WithEvents wks as Worksheet,然后就可以把表sheet1传递给wks,如何传递?当然是通过属性了,下面,把如下代码加入rngFormatDS模块。 - Public Property Set Sheet(msh As Worksheet)
- Set wks = msh
- End Property
- Public Property Get Sheet()
- Set Sheet=wks
- End Property
复制代码 然后,我们就可以在左上角的下拉列表中选择wks,在右边的下拉列表中选择BeforeDoubleClick或BeforeRightClick了。
不过,在这之前,与rColor方法相对应,我们给rngFormat类加一个“去色”的方法,在类中加入如下代码: - Public Function unColor()
- m_oCell.Interior.ColorIndex = xlNone
- End Function
复制代码 现在,回到rngFormatDS类,我们可以给wks 的BeforeDoubleClick事件添加代码了,代码很简单,先把字典(csDic)中的rngFormat实例放到数组(arArray)中,再循环数组,当循环到的rngFormat的whattype属性与通过双击单元格地址索引到的rngFormat属性相同时,执行着色(rColor)方法。代码如下:
Private Sub wks_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim arArray As Variant
Dim lIndex As Long
arArray = csDic.Items 'arArray 即包含所有rngFormat对象的数组
If Application.Intersect(Range("data"), Target) Is Nothing Then Exit Sub '为方便把A1:A41命名为Data,如右击此外的单元格则退出程序
For lIndex = LBound(arArray) To UBound(arArray)
If arArray(lIndex).WhatType = csDic(Target.Cells(1).Address).WhatType Then '这里用Target.cells(1).address取代Target.address,可防止出错。
arArray(lIndex).rColor
Cancel = True
End If
Next lIndex
End Sub
然后,我们给右键单击事件添加代码,只须修改arArray(lIndex).rColor 为arArray(lIndex).unColor 即可,代码就不在这里写了,参见
类_5.rar
(35.98 KB, 下载次数: 85)
。 引发事件实例: 前面,集合类rngFormatDS通过捕捉worksheet的双击和右击事件,实现了双击着色,右击去色的功能。 我们也可以让集合类rngFormatDS象worksheet等对象一样,有自己的事件,然后其他的类可以捕获这些事件,这怎么实现呢? 1 因为我们要在类rngFormatDS中增加一个它自己的事件,然后类rngFormat去引用这个事件,这样类rngFormatDS 和 rngFormat就形成了父子关系,在这种情况下,需要把他们都要用到的公共变量放到父类中去。所以,我们到rngFormat中去,把枚举变量cType剪切掉,然后粘贴到rngFormatDS的顶部。 2 在rngFormatDS中声明一个事件: Event ChangeColor(rngType As cType, bOn As Boolean) 3 何时引发这个事件呢?当然是在双击或右击鼠标时引发,所以我们修改wks_BeforeDoubleClick和wks_BeforeRightClick和事件代码如下:
Private Sub wks_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim arArray As Variant
Dim lIndex As Long
arArray = csDic.Items
If Application.Intersect(Range("data"), Target) Is Nothing Then Exit Sub '
RaiseEvent ChangeColor(csDic(Target.Cells(1).Address).WhatType, True) '第一个参数指明哪种类型的实例需要变动颜色,第二个参数指明该变动是着色还是去色。
Cancel = True
End Sub
Private Sub wks_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim arArray As Variant
Dim lIndex As Long
arArray = csDic.Items
If Application.Intersect(Range("data"), Target) Is Nothing Then Exit Sub
RaiseEvent ChangeColor(csDic(Target.Cells(1).Address).WhatType, False)
Cancel = True
End Sub
4 此时,我们需要到rngFormat类中去捕获changecolor事件,象捕获Excel自身对象的事件一样,在顶部做如下声明:- Private WithEvents rDS As rngFormatDS
复制代码 5我们需要建一个属性,把父类传递给参数rDS,这里我们建一个叫Parent的属性,代码如下: - Public Property Set Parent(objParent As rngFormatDS)
- Set rDS = objParent
- End Property
复制代码 6此时,我们就可以在左上角下拉列表中选rDS,在类此给rDS_ChangeColor事件添加代码了: - Private Sub rDS_ChangeColor(rngType As cType, bOn As Boolean)
- If mDatatype = rngType Then
- If bOn Then
- rColor
- Else
- unColor
- End If
- End If
- End Sub
复制代码 代码很容易理解,当本实例的类型等于ChangeColor事件的第一个参数传递过来的类型时,判断ChangeColor事件第二个参数是否为真,是的话着色,不是的话去色。 7还剩最后一步,到rngFormatDS类中去,在其Add方法中加如下代码: 这样,子类与父类的关系就建立了,add方法的完整代码如下:
- Public Sub Add(rng As Range)
- Dim rF As rngFormat
- Set rF = New rngFormat
- Set rF.Cell = rng
- Set rF.Parent = Me
- rF.WhatType
- Set csDic(rF.Cell.Address) = rF
- End Sub
复制代码 看到这里的朋友可下载
类_6.rar
(37.35 KB, 下载次数: 80)
,进行测试。 |