Specific Class factory

[tiredofit]

The following code is taken from here:

https://www.youtube.com/watch?v=rZ96jR_y4gY

This is in Sheet1

Option Explicit

Sub CreateReport()
    Dim animals As New Collection
    Dim animal As Variant
    Dim choice As String
    Dim rng As Range
    Dim x As Integer
    Dim firstRow
    Dim lastRow As Integer

    ' Set parameters, no such thing as 'Fishs' so don't change that word
    If (Range("J5") = "Fish") Then
        choice = Range("J5")
    Else
        choice = Left(Range("J5"), Len(Range("J5")) - 1)
    End If
    
    firstRow = 4
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    ' Use a loop and parse all of the animals into their respective classes
    For x = firstRow To lastRow
        Set rng = Range("A" & x & ":H" & x)
        Set animal = AnimalClassFactory(rng)
        animals.Add animal
    Next x
    
    PrintCollection animals, "animals"
    
    printReport animals, choice
End Sub

Sub PrintCollection(coll As Collection, name As String)

    Debug.Print vbNewLine & "Printing " & name & ":"

    On Error Resume Next
    Dim item As Variant
    
    For Each item In coll
        Debug.Print item.PrintOut()
    Next item
    
    On Error GoTo 0

End Sub

This is in a class called Animal:

' This is the Interface for the Cat and Dog classes.
' The Cat and Dog classes are required to implement
' these properties as they 'implement Animal'

Option Explicit

Public Property Get name() As String
End Property

Public Property Get Age() As Long
End Property

Public Property Get Weight() As Double
End Property

Public Property Get Talk() As String
End Property

This is in a class called Cat:

' Cat class derived from Animal interface
Option Explicit

 ' Implements Animal interface requiring the name, age and weight.
Implements animal

Private name_ As String
Private age_ As Long
Private breed_ As String
Private weight_ As Double
Private legs_ As Integer
Private likes_ As Variant
Private arrivalDate_ As Date
Private readyToHouse_ As Boolean
Private icon_ As Shape
Private meow_ As String ' unique to the Cat class

Private Sub Class_Initialize()
    legs_ = 4
    meow_ = "Meoww!"
   '  Set icon_ = Sheets("Icons").Shapes("catPic")
End Sub

Public Sub Init(rng As Range)
    name_ = rng.Cells(1, 1)
    age_ = rng.Cells(1, 3)
    breed_ = rng.Cells(1, 4)
    weight_ = rng.Cells(1, 5)
    likes_ = Split(CStr(rng.Cells(1, 7).Value), ",")
    arrivalDate_ = rng.Cells(1, 6)
    If (rng.Cells(1, 8) = "Y") Then readyToHouse_ = True
End Sub

Public Sub PrintOut()
Debug.Print name_, TypeName(Me), age_, breed_, weight_, arrivalDate_, readyToHouse_, legs_, daysHoused;
End Sub

Public Property Get readyToHouse() As Boolean
    readyToHouse = readyToHouse_
End Property

Private Sub Class_Terminate()
    ' Debug.Print "Cat class instance deleted, meow! (Goodbye)"
End Sub

Public Property Get Legs() As Integer
    Legs = legs_
End Property

Public Property Get Breed() As String
    Breed = breed_
End Property

Public Property Get name() As String
    name = name_
End Property

Public Property Let name(ByVal Value As String)
    name_ = Value
End Property

Public Property Get Age() As Long
    Age = age_
End Property

Public Property Let Age(ByVal Value As Long)
    age_ = Value
End Property

Public Property Get Weight() As Double
    Weight = weight_
End Property

Public Property Let Weight(ByVal Value As Double)
    weight_ = Value
End Property

Public Property Get likes() As Collection
    Set likes = likes_
End Property

Public Property Set likes(Value As Collection)
    Set likes_ = Value
End Property

Public Property Get Talk() As String
    Talk = meow_
End Property

Public Property Get Meow() As String
    Meow = "The cat says: " & meow_
End Property

Public Property Let Talk(ByVal Value As String)
    meow_ = Value
End Property

Public Property Get daysHoused() As Integer
    daysHoused = Now() - arrivalDate_
End Property

' Implement required interface properties
Private Property Get Animal_Name() As String
    Animal_Name = name
End Property

Private Property Get Animal_Age() As Long
    Animal_Age = Age
End Property

Private Property Get Animal_Weight() As Double
    Animal_Weight = Weight
End Property

Private Property Get Animal_Talk() As String
    Animal_Talk = Meow
End Property

What I don't understand is when the code reaches this point:

Sub PrintCollection(coll As Collection, name As String)

    Debug.Print vbNewLine & "Printing " & name & ":"

    On Error Resume Next
    Dim item As Variant
    
    For Each item In coll
        Debug.Print item.PrintOut() '******************************* 
    Next item
    
    On Error GoTo 0

End Sub

after the line with ************************** is executed, the code jumps to the appropriate class.

How does it know which class to go to?

 

[Kyle123]

It's sometimes useful to have real world examples for this. Coincidentally I had to fix a workbook the other day that I made a few years ago that uses this pattern.

Late binding is typically preferential when creating workbooks that will be circulated to a wide audience, the problem with it is that it can lead to significant performance issues. We had a customer that would download large amounts of XML into a custom pricing tool that we made for them, parsing XML using MSXML when early binding is fast, however when late binding, the performance is abysmal.

I wrote 2 classes that both implemented a generic IDataParser interface (some what simplified to):

Option Explicit
Public Function GetData() As Variant: End Function

One used early binding, the other late.

I used a Factory method then to return the correct DataParser depending on user configurable options in a sheet. If the users had the correct MSXML library then they could use the "Normal" option, but we could tell them to switch to the "Legacy" option if they had a missing reference to the specific XML library required in the early binding class.

VBA handily doesn't try to compile code in modules that aren't accessed, so it was safe to have static types from the MSXML library in the early binding class even with missing references on the users machine.

However the calling code only had to know about the IDataParser interface and not deal with the underlying implementation.

 

[tiredofit]

thanks for sharing your solution.

 

[GWteB]

I disagree, this is a factory.

It's a factory method indeed, but that doesn't make it a factory class. Imo a factory class is an object responsible for creating other objects, or are we talking about a class factory ...

in fact it can't instantiate itself, you can only instantiate an object from the outside

The lack of ability of explaining something clearly is turning against me

Of course, the initiative to create a specific object must be taken outside its class, but the process of creation can happen within the class itself. That's why I mentioned the PredeclaredID module attribute, which makes it possible (when set to True) to invoke public procedures of its default instance. That would be just one function: to let the class give birth to the object it's representing.
The object's public interface exposes all necessary methods and properties.
Below is a stripped-down version of the OP's Cat class. Note that the object's initialize process takes place at creation time by injecting the object's dependency.

Cat class (Predeclared):

Option Explicit
' >> Predeclared <<

' Cat class
Implements IAnimal

Private Type TCat
    Name    As String
    Breed   As String
End Type
Private this As TCat

Public Function Create(ByVal PropertySource As Range) As IAnimal
    Dim Result As Cat
    Set Result = New Cat
    InjectProps Result, PropertySource
    Set Create = Result
End Function

Private Sub InjectProps(ByVal Instance As IAnimal, ByVal argProps As Range)
    With argProps
        Instance.Name = .Cells(1, 1)
        Instance.Breed = .Cells(1, 4)
    End With
End Sub

Private Sub IAnimal_MakeSound()
    Debug.Print "Meow"
End Sub

Private Property Let IAnimal_Breed(ByVal RHS As String)
    this.Breed = RHS
End Property
Private Property Get IAnimal_Breed() As String
    IAnimal_Breed = this.Breed
End Property

Private Property Let IAnimal_Name(ByVal RHS As String)
    this.Name = RHS
End Property
Private Property Get IAnimal_Name() As String
    IAnimal_Name = this.Name
End Property

Calling code:

Dim SomeCat As IAnimal

Set SomeCat = Cat.Create(rng)
Name = SomeCat.Name
Breed = SomeCat.Breed

As mentioned, this code only runs after an adjustment. This is easily achieved by having a pre-made class file at your fingertips, importing it into VBE (CTRL M), renaming the class module created in this way and finally put your code in.
File Predeclared_CLASS.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Predeclared_CLASS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' >> Predeclared <<

 

[Kyle123]

We're talking about a class factory, not a factory class

Using the `VB_PredeclaredId` is best avoided for the same reason that the default instance of userforms are best avoided. I also don't think what you're proposing is really a solution to what a class factory is for, it essentially promotes a singleton whose state you can't check - needing multiple cats would be confusing.

I think really we're talking about different things, what you've created is a solution to VBA not having constructors, I don't think using the `PredeclaredId` method is a good solution though in this context, for this I'd favour using a module as a faux static singleton:

Dim cat As IAnimal

Set cat = CatFactory.Create(rng)

with a module named CatFactory

Public Function Create(ByVal PropertySource As Range) As IAnimal
    Dim Result As Cat
    Set Result = New Cat
    With Cat 
        .Name = PropertySource.Cells(1, 1)
        .Breed = PropertySource.Cells(1, 4)
    End With
    Set Create = Result
End Function

 

[GWteB]

Using the `VB_PredeclaredId` is best avoided for the same reason that the default instance of userforms are best avoided.

I disagree. I'm always coding against interface classes, also when using Userforms, and that way methods and properties that should be exposed are exposed and implementation details are carefully hidden. We could discuss this sort of thing for a very long time, but I'm not going to hijack this thread for that ... different folks, different strokes

 

[RoryA]

Why would you need VB_PredeclaredId for that?

 

[GWteB]

Why would you need VB_PredeclaredId for that?

Not for "that", just to be able to invoke a method from the default instance of a class, like the Create function in the example of my post #13.