- Creating Objects
- Creating a Collection
- Trapping Events
- Raising Events
- Practical Example
- Summary
This chapter is from the book
This chapter is from the book
This chapter is from the book
Raising Events
Another powerful capability of class modules is the ability to raise events. You can define your own events and trigger them in your code. Other class modules can trap those events and respond to them. To illustrate this we change the way our Cells collection tells the Cell objects it contains to execute their Highlight and UnHighlight methods. The Cells collection raises an event that will be trapped by the Cell objects. The code shown in this section is contained in the Analysis5.xls workbook in the \Concepts\Ch07 – Using Class Modules to Create Objects folder on the CD that accompanies this book. To raise an event in a class module you need two things.
- An Event declaration at the top of the class module
- A line of code that uses RaiseEvent to cause the event to take place
The code changes shown in Listing 7-13 should be made in the CCells class module.
Listing 7-13. Changes to the CCells Class Module to Raise an Event
Option Explicit
Public Enum anlCellType
anlCellTypeEmpty
anlCellTypeLabel
anlCellTypeConstant
anlCellTypeFormula
End Enum
Private mcolCells As Collection
Private WithEvents mwksWorkSheet As Excel.Worksheet
Event ChangeColor(uCellType As anlCellType, bColorOn As Boolean)
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
Note that we moved the anlCellType Enum declaration into the parent collection class module. Now that we have created an explicit parent-child relationship between the CCells and CCell classes, any public types used by both classes must reside in the parent class module or circular dependencies between the classes that cannot be handled by VBA will be created.
In the declarations section of the CCells module, we declare an event named ChangeColor that has two arguments. The first argument defines the cell type to be changed, and the second argument is a Boolean value to indicate whether we are turning color on or off. The BeforeDoubleClick and BeforeRightClick event procedures have been changed to raise the new event and pass the cell type of the target cell and the on or off value. The Add method has been updated to set a new Parent property of the Cell object. This property holds a reference to the Cells object. The name reflects the relationship between the Cells object as the parent object and the Cell object as the child object.
Trapping the event raised by the Cells object in another class module is carried out in exactly the same way we trapped other events. We create a WithEvents object variable and set it to reference an instance of the class that defines and raises the event. The changes shown in Listing 7-14 should be made to the CCell class module.
Listing 7-14. Changes to the CCell Class Module to Trap the ChangeColor Event
Option Explicit
Private muCellType As anlCellType
Private mrngCell As Excel.Range
Private WithEvents mclsParent As CCells
Property Set Parent(ByRef clsCells As CCells)
Set mclsParent = clsCells
End Property
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
A new module-level object variable mclsParent is declared WithEvents as an instance of the CCells class. A reference to a Cells object is assigned to mclsParent in the Parent Property Set procedure. When the Cells object raises the ChangeColor event, all the Cell objects will trap it. The Cell objects take action in response to the event if they are of the correct cell type.
A Family Relationship Problem
Unfortunately, we introduced a problem in our application. Running the CreateCellsCollection procedure multiple times creates a memory leak. Normally when you overwrite an object in VBA, VBA cleans up the old version of the object and reclaims the memory that was used to hold it. You can also set an object equal to Nothing to reclaim the memory used by it. It is good practice to do this explicitly when you no longer need an object, rather than relying on VBA to do it.
Set gclsCells = Nothing
When you create two objects that store references to each other, the system will no longer reclaim the memory they used when they are set to new versions or when they are set to Nothing. When analyzing the worksheet in Analysis5.xls with 574 cells in the used range, there is a loss of about 250KB of RAM each time CreateCellsCollection is executed during an Excel session.
One way to avoid this problem is to make sure you remove the cross-references from the linked objects before the objects are removed. You can do this by adding a method such as the Terminate method shown in Listing 7-15 to the problem classes, in our case the CCell class.
Listing 7-15. The Terminate Method in the CCell Class Module
Public Sub Terminate()
Set mclsParent = Nothing
End Sub
The code in Listing 7-16 is added to the CCells class module. It calls the Terminate method of each Cell class contained in the collection to destroy the cross-reference between the classes.
Listing 7-16. The Terminate Method in the CCells Class Module
Public Sub Terminate()
Dim clsCell As CCell
For Each clsCell In mcolCells
clsCell.Terminate
Set clsCell = Nothing
Next clsCell
Set mcolCells = Nothing
End Sub
The code in Listing 7-17 is added to the CreateCellsCollection procedure in the MEntryPoints module.
Listing 7-17. The CreateCellsCollection Procedure in the MEntryPoints Module
Public Sub CreateCellsCollection()
Dim clsCell As CCell
Dim rngCell As Range
' Remove any existing instance of the Cells collection
If Not gclsCells Is Nothing Then
gclsCells.Terminate
Set gclsCells = Nothing
End If
Set gclsCells = New CCells
Set gclsCells.Worksheet = ActiveSheet
For Each rngCell In ActiveSheet.UsedRange
gclsCells.Add rngCell
Next rngCell
End Sub
If CreateCellsCollection finds an existing instance of gclsCells it executes the object's Terminate method before setting the object to Nothing. The gclsCells Terminate method iterates through all the objects in the collection and executes their Terminate methods.
In a more complex object model with more levels you could have objects in the middle of the structure that contain both child and parent references. The Terminate method in these objects would need to run the Terminate method of each of its children and then set its own Parent property to Nothing.
Creating a Trigger Class
Instead of raising the ChangeColor event in the CCells class module we can set up a new class module to trigger this event. Creating a trigger class gives us the opportunity to introduce a more efficient way to highlight our Cell objects. We can create four instances of the trigger class, one for each cell type, and assign the appropriate instance to each Cell object. That means each Cell object is only sent a message that is meant for it, rather than hearing all messages sent to all Cell objects.
The trigger class also enables us to eliminate the Parent/Child relationship between our CCells and CCell classes, thus removing the requirement to manage cross-references. Note that it is not always possible or desirable to do this. The code shown in this section is contained in the Analysis6.xls workbook in the \Concepts\Ch07 – Using Class Modules to Create Objects folder on the CD that accompanies this book.
Listing 7-18 shows the code in a new CTypeTrigger class module. The code declares the ChangeColor event, which now only needs one argument to specify whether color is turned on or off. The class has Highlight and UnHighlight methods to raise the event.
Listing 7-18. The CTypeTrigger Class Module
Option Explicit
Public Event ChangeColor(bColorOn As Boolean)
Public Sub Highlight()
RaiseEvent ChangeColor(True)
End Sub
Public Sub UnHighlight()
RaiseEvent ChangeColor(False)
End Sub
Listing 7-19 contains the changes to the CCell class module to trap the ChangeColor event raised in CTypeTrigger. Depending on the value of bColorOn, the event procedure runs the Highlight or UnHighlight methods.
Listing 7-19. Changes to the CCell Class Module to Trap the ChangeColor Event of CTypeTrigger
Option Explicit
Private muCellType As anlCellType
Private mrngCell As Excel.Range
Private WithEvents mclsTypeTrigger As CTypeTrigger
Property Set TypeTrigger(clsTrigger As CTypeTrigger)
Set mclsTypeTrigger = clsTrigger
End Property
Private Sub mclsTypeTrigger_ChangeColor(bColorOn As Boolean)
If bColorOn Then
Highlight
Else
UnHighlight
End If
End Sub
Listing 7-20 contains the changes to the CCells module. An array variable maclsTriggers is declared to hold the instances of CTypeTrigger. The Initialize event redimensions maclsTriggers to match the number of cell types and the For...Each loop assigns instances of CTypeTrigger to the array elements. The Add method assigns the correct element of maclsTriggers to each Cell object according to its cell type. The result is that each Cell object listens only for messages that apply to its own cell type.
Listing 7-20. Changes to the CCells Class Module to Assign References to CTypeTrigger to Cell Objects
Option Explicit
Public Enum anlCellType
anlCellTypeEmpty
anlCellTypeLabel
anlCellTypeConstant
anlCellTypeFormula
End Enum
Private mcolCells As Collection
Private WithEvents mwksWorkSheet As Excel.Worksheet
Private maclsTriggers() As CTypeTrigger
Private Sub Class_Initialize()
Dim uCellType As anlCellType
Set mcolCells = New Collection
' Initialise the array of cell type triggers,
' one element for each of our cell types.
ReDim maclsTriggers(anlCellTypeEmpty To anlCellTypeFormula)
For uCellType = anlCellTypeEmpty To anlCellTypeFormula
Set maclsTriggers(uCellType) = New CTypeTrigger
Next uCellType
End Sub
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 As anlCellType)
maclsTriggers(uCellType).Highlight
End Sub
Public Sub UnHighlight(ByVal uCellType As anlCellType)
maclsTriggers(uCellType).UnHighlight
End Sub
Private Sub mwksWorkSheet_BeforeDoubleClick( _
ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, _
mwksWorkSheet.UsedRange) Is Nothing Then
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 Nothing Then
UnHighlight mcolCells(Target.Address).CellType
Cancel = True
End If
End Sub
Private Sub mwksWorkSheet_Change(ByVal Target As Range)
Dim rngCell As Range
Dim clsCell As CCell
If Not Application.Intersect(Target, _
mwksWorkSheet.UsedRange) Is Nothing Then
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