Comments on: Collection Add and Functions

By: Andy Pope

Andy Pope — Thu, 06 Sep 2007 17:14:00 +0000

Ads,

You need to export the Group class and edit the bas file, as KeepItCool mentions
Quote:"Group has Enumeration to enable for/each.
(needs editing on exported module to set the attributes)"

See Chip's page on the subject.
http://www.cpearson.com/excel/DefaultProperty.htm

By: Adam

Adam — Thu, 06 Sep 2007 00:44:00 +0000

Hi there,
I tried the above slice of cade in excel and it stops at the following line with a runtime error '438' not being able to supportthe Contect property.

"For Each Contact In Group"

Any idea why this is stopping here?

Cheers

Ads

By: Mike Woodhouse

Mike Woodhouse — Thu, 23 Aug 2007 12:01:00 +0000

I’d say the create-in-a-function idea is an instance of a “Factory Method”. Or the VBA equivalent. It’s about the best we can do in a COM-influenced world where we don’t get parameterised constructors.

I do like – and often use – the idea from keepItCool: building a custom collection class, even though it needs a little external hacking to get enumeration working (I’m sure someone like Rob Bovey could extend VBE to export, hack and reimport the class…)

By: keepITcool

keepITcool — Thu, 23 Aug 2007 10:24:00 +0000

A variation:

Contact is the simplest class, defacto a user defined type.
Group does the handling of creating the contact objects.
Group has Enumeration to enable for/each.
(needs editing on exported module to set the attributes)

'Module1
Option Explicit

Sub Test()
Dim Groups As Collection
Dim Group As CGroup
Dim Contact As CContact

Set Groups = GetGroups

For Each Group In Groups
For Each Contact In Group
If Contact.State = "NE" Then
With Contact
Debug.Print Group.Name, .State, .Name, .Company
End With
End If
Next
Next
End Sub

Function GetGroups() As Collection
Dim Group As CGroup

Set GetGroups = New Collection

Set Group = New CGroup
With Group
.Name = "Group1"
.AddContact "Dick Kusleika", "Company1", "NE"
.AddContact "John Doe", "Company2", "NE"
.AddContact "Jane Doe", "Company2", "MA"
End With
GetGroups.Add Group, Group.Name

Set Group = New CGroup
With Group
.Name = "Group2"
.AddContact "Ed Poe", "Company3", "AZ"
.AddContact "Bill Shakes", "Company2", "OR"
.AddContact "Emily Bronte", "Company4", "FL"
End With
GetGroups.Add Group, Group.Name

Set Group = New CGroup
With Group
.Name = "Group3"
.AddContact "Henry Ford", "Company5", "MI"
.AddContact "Andy Carnegie", "Company5", "NE"
.AddContact "Johnny Rocky", "Company4", "NY"
End With
GetGroups.Add Group, Group.Name

End Function

'PublicNotCreatable Class CContact
Public Name As String
Public Company As String
Public State As String

'PublicNotCreatable Class CGroup
Option Explicit

Dim myContacts As Collection
Public Name As String

Sub AddContact(Name As String, Company As String, State As String)
Dim Contact As CContact
Set Contact = New CContact
Contact.Name = Name
Contact.Company = Company
Contact.State = State

If Len(Name) = 0 Then
Err.Raise -1, , "Contact Name must be supplied"
Else
myContacts.Add Contact, Contact.Name
End If

End Sub

Function Contact(Index As Variant) As CContact
'Attribute Contact.VB_UserMemId = 0
Set Contact = myContacts.Item(Index)
End Function

Function NewEnum() As IUnknown
'Attribute NewEnum.VB_UserMemId = -4
'Attribute NewEnum.VB_MemberFlags = "40"
Set NewEnum = myContacts.[_NewEnum]
End Function

Private Sub Class_Initialize()
Set myContacts = New Collection
End Sub

By: Tushar Mehta

Tushar Mehta — Thu, 23 Aug 2007 06:22:00 +0000

Hi Dick:

When creating a class consider putting as much of the functionality into the class rather than relying on the client doing things correctly. For example, I would have the parent class add a single element object not an entire collection since one doesn't know what is in the collection.

So, clsParent would contain:

Option Explicit

Dim AllElements As Collection

Public Sub addElement(Ele As clsElement)
On Error Resume Next
AllElements.Add Ele, Ele.Key
End Sub

Private Sub Class_Initialize()
Set AllElements = New Collection
End Sub

For the sake of simplicity I assumed that clsElement has a Key. But, PED shows how to generalize the idea.

I would even put the responsibility of listing all the elements into the class with

Public Function ListAll() As String
Dim vEle As Variant, Ele As clsElement
For Each vEle In AllElements
Set Ele = vEle
ListAll = ListAll & Ele.Key & "=" & Ele.Val & vbNewLine
Next vEle
End Function

Now, if we have an element class named clsElement containing

Option Explicit

Dim sKey As String, sVal As String

Property Let Key(uKey As String): sKey = uKey: End Property
Property Get Key() As String: Key = sKey: End Property

Property Let Val(uVal As String): sVal = uVal: End Property
Property Get Val() As String: Val = sVal: End Property

we would use the above with code in a standard module as in

Option Explicit

Dim aParent As clsParent

Function addEle(ByVal Key As String, ByVal Val As String) As clsElement
Dim Ele As New clsElement
Ele.Key = Key
Ele.Val = Val
Set addEle = Ele
End Function
Sub demoClasses()
Set aParent = New clsParent
aParent.addElement addEle("1", "One")
aParent.addElement addEle("2", "Two")
Debug.Print aParent.ListAll
Set aParent = Nothing
End Sub

One thing that VB doesn't support is overloading functions. That is why we cannot use something like

dim anEle as clsElement
set anEle = new clsElement ("1", "One")
aParent.addelement anEle

or even better

aParent.addelement new clsElement ("1", "One")

But, we can do something similar with the following:

Add to clsElement:

Public Sub Init(ByVal Key As String, Val As String)
Me.Key = Key: Me.Val = Val
End Sub

Now, the standard module code could be shortened to

Option Explicit

Dim aParent As clsParent

Function addEle(ByVal Key As String, ByVal Val As String) As clsElement
Set addEle = New clsElement: addEle.Init Key, Val
End Function
Sub demoClasses()
Set aParent = New clsParent
aParent.addElement addEle("1", "One")
aParent.addElement addEle("2", "Two")
Debug.Print aParent.ListAll
Set aParent = Nothing
End Sub

We can take it a step further approaching

aParent.addelement new clsElement ("1", "One")

with the following:

In the clsElement class replace the Init sub with

Public Function Init(ByVal Key As String, Val As String) As clsElement
Me.Key = Key: Me.Val = Val
Set Init = Me
End Function

Now with a function that creates an empty object, the code in the standard module becomes

Option Explicit

Dim aParent As clsParent

Function newClsElement() As clsElement
Set newClsElement = New clsElement
End Function
Sub demoClasses()
Set aParent = New clsParent
aParent.addElement newClsElement.Init("1", "One")
aParent.addElement newClsElement.Init("2", "Two")
Debug.Print aParent.ListAll
Set aParent = Nothing
End Sub

This, the use of a function to create an empty object, is how one can also use a class declared in another workbook/addin. See
How to use a class (object) from outside of the VBA project in which it is declared
http://support.microsoft.com/kb/555159