Changes to a class factory

tiredofit

Well-known Member
Joined
Apr 11, 2013
Messages
1,556
Office Version
  1. 2019
Platform
  1. Windows
This video shows how to create a class factory, which also allows touches upon polymorphism:

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

and looks like this:

1621166464907.png


Here is some of the code:

Code:
' Class module 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

class module dog:

Code:
' Dog 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 arrivalDate_ As Date
Private likes_ As Variant
Private icon_ As Shape
Private bark_ As String ' unique to the Dog class
Private readyToHouse_ As Boolean

Private Sub Class_Initialize()
    legs_ = 4
    bark_ = "Woof!"
    ' Set icon_ = Sheets("Icons").Shapes("fishPic")
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)
    arrivalDate_ = rng.Cells(1, 6)
        likes_ = Split(CStr(rng.Cells(1, 7).Value), ",")
    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 Breed() As String
    Breed = breed_
End Property

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

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

Public Property Get Legs() As Integer
    Legs = legs_
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 Bark() As String
    Bark = "The dog says: " & bark_
End Property

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

Public Property Let Talk(ByVal Value As String)
    bark_ = 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 daysHoused() As Integer
    daysHoused = Now() - arrivalDate_
End Property

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 = Bark
End Property

What I don't understand is if some new data was pasted onto the spreadsheet that contained a new animal, eg elephant, how would the program work?

Would the programmer have to create a new class called elephant beforehand?

Thanks
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,825
Office Version
  1. 365
Platform
  1. Windows
Yes, that's right. You would have to create an Elephant class.

Notice, though, while it implements an Animal interface class, it doesn't actually use the interface properties. That's probably because the tutorial is on classes in general, not interface classes, and the code is there for some another tutorial.
 
Last edited:

tiredofit

Well-known Member
Joined
Apr 11, 2013
Messages
1,556
Office Version
  1. 2019
Platform
  1. Windows
Yes, that's right. You would have to create an Elephant class.

Notice, though, while it implements an Animal interface class, it doesn't actually use the interface properties. That's probably because the tutorial is on classes in general, not interface classes, and the code is there for some another tutorial.
Thanks for clarifying.
 

Forum statistics

Threads
1,147,559
Messages
5,741,808
Members
423,689
Latest member
Jords998

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top