So magic DispIds (short for Dispatch IDs) have been on my mind today, a clutch of posts earlier about using bang syntax once you set a method dispid to zero. Here we talk about another magic number -4 which denotes an enumeration factory method that VBA will call on your object if found in a For Each .. In .. construct.
Other bloggers usually illustrate this with a canonical example about collection classes. Instead, I'll give a twist on Linq's Where filter function. We'll need a class, but first here is the client (standard) module. This module also houses the predicate SheetIsOdd used to tell if a sheet gets added to the collection or not.
Option Explicit
Sub Test()
Dim oWhere As New Where
Dim wsOdd As Variant
For Each wsOdd In oWhere.Init(ThisWorkbook.Worksheets, "SheetIsOdd")
Debug.Print wsOdd.Name
Next
End Sub
Function SheetIsOdd(sh As Excel.Worksheet) As Boolean
Dim lSuffix As Long
If IsNumeric(Right$(sh.Name, 1)) Then
lSuffix = Right$(sh.Name, 1)
End If
If lSuffix Mod 2 = 1 Then
SheetIsOdd = True
End If
End Function
Where class
The Where class has an Init method that returns an instance of itself to allow chaining methods. The NewEnum method delegates the enumeration to a VBA.Collection populated during Init. The NewEnum method cannot take parameters because it is defined as parameterless. We supply parameters via Init and use chaining methods so it appears seamless.
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Where"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private mcol As VBA.Collection
Private mSrcCol As Object
Private msCallbackPredicate As String
Public Function Init(ByVal col As Excel.Sheets, ByVal sCallbackPredicate As String) As Where
Set mSrcCol = col
msCallbackPredicate = sCallbackPredicate
Set Init = Me '* allows chaining
End Function
Public Function NewEnum() As IEnumVARIANT
Attribute NewEnum.VB_UserMemId = -4
'Attribute NewEnum.VB_UserMemId = -4
Set mcol = New VBA.Collection
Dim oLoop As Object
For Each oLoop In mSrcCol
If Application.Run(msCallbackPredicate, oLoop) Then
mcol.Add oLoop
End If
Next
Set NewEnum = mcol.[_NewEnum]
End Function
No comments:
Post a Comment