- Creating Objects
- Creating a Collection
- Trapping Events
- Raising Events
- Practical Example
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