VBA Factory method with Private Variables - vba

So I Have a Factory Class with method Create_product
Product happens to have Private Variables that I would like to be set by Factory however if they are private how can I make Factory access them?
Preferably I want it to be impossible to change them after new instance of Product is created.

Friend
Modifies the definition of a procedure in a form module or class module to make the procedure callable from modules that are outside the class, but part of the project within which the class is defined. Friend procedures cannot be used in standard modules.
Syntax
[Private | Friend | Public] [Static] [Sub | Function | Property] procedurename
The required procedurename is the name of the procedure to be made visible throughout the project, but not visible to controllers of the class.
Remarks
Public procedures in a class can be called from anywhere, even by controllers of instances of the class. Declaring a procedure Private prevents controllers of the object from calling the procedure, but also prevents the procedure from being called from within the project in which the class itself is defined. Friend makes the procedure visible throughout the project, but not to a controller of an instance of the object. Friend can appear only in form modules and class modules, and can only modify procedure names, not variables or types. Procedures in a class can access the Friend procedures of all other classes in a project. Friend procedures don't appear in the type library of their class. A Friend procedure can't be late bound.

Use a singleton class as is 1
Create form module named Singleton:
Private SingleInsts As Collection
Private instCount As Double
Public isCalled As Boolean
Private Sub UserForm_Initialize()
Me.Hide
Me.isCalled = False
End Sub
Private Function setInstance(name As String) As Object
Dim Obj As Object
If SingleInsts Is Nothing Then Set SingleInsts = New Collection
instCount = SingleInsts.Count
ReDim singleNames(instCount + 1)
Me.isCalled = True
Select Case name
Case "Example"
Set Obj = New Example
Case "Other"
Set Obj = New Other 'etc. etc - Case ... for all classes
Case Else
Err.Raise vbObjectError + 800, Err.Source & "|" & Me.name & "." & "setInstance", name & " is not a classname"
End Select
Me.isCalled = False
SingleInsts.Add Obj, name
Set setInstance = Obj
Exit Function
End Function
Public Function getInstance(name As String) As Object
On Error Resume Next
If (SingleInsts(name) Is Nothing) And False Then
'this way only by error - when SingleInsts(name) doesn't exist
Set getInstance = setInstance(name)
Else
Set getInstance = SingleInsts(name)
End If
End Function
Public Function errNew(errstr As String)
Err.Raise vbObjectError + 703, errstr
End Function
This function has to be in all classes:
Private Sub Class_Initialize()
If Not Singleton.isCalled Then Singleton.errNew TypeName(Me)
End Sub
And then call "factory" method to get object (an object can be instantiated only once - see getInstance method in Singleton)
Sub fo()
set alfa = Singleton.getInstance("Example")
End sub

Related

Access a class modules variables within a second class

I was wondering if there's a way in which I can share variables between instances of separate class modules?
I have two classes:
Class 1
Class 2
Inside class 1, I have multiple global variables which I would like Class 2 to have access to once instantiated.
I could use get and set properties for each of the variables but I have about 40/50 so it just seems a bit tedious.
So, instead, I'm trying to pass the current instance of Class 1 to Class 2 using set property.
I've created a minimal example to illustrate my current efforts:
Class 1:
Public test As String
Private Sub Class_Initialize()
Call setTest
Dim b As Class2
Set b = New Class2
End Sub
Public Property Set Classed(ByRef vClass As Class1)
Set vClass = Me
End Property
Public Sub setTest(t As String)
test = "Sam"
End Sub
Class 2:
Private Sub Class_Initialize()
Dim newClass As Class1
newClass.Classed = newClass
' Want to be able to access the test String from class 1
End Sub
Obviously what I am doing at the moment is incorrect, so am wondering if someone could point out where I'm going wrong and show me how to achieve this class sharing?
Just to add: when running the code, I receive a compile error at line: newClass.Classed = newClass. Error: Invalid use of property
Not too sure but I sense a bit of a Circular Reference in your example?
What Are Circular References?
A circular reference occurs when two objects hold references to each other.
You could try an alternative by exposing a Dictionary object through your class, where the Key will be your "variable name", and the Value will hold the actual value.
An example could be:
Class1
Option Explicit
Private mList As Object
Public Property Get List() As Object
Set List = mList
End Property
Private Sub Class_Initialize()
Set mList = CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
Set mList = Nothing
End Sub
Implementation:
Sub ClassTest()
Dim a As Class1
Set a = New Class1
Dim b As Class1
Set b = New Class1
a.List("VarName") = "Sam" 'Set
b.List("VarName") = a.List("VarName") 'Get / Set
Debug.Print b.List("VarName") 'Get
Set a = Nothing
Set b = Nothing
End Sub
'Output
'Sam

Sub function to show UserForm

I have an excel file with multiple UserForms. To open a UserForm I have code such as
Sub runAdjuster()
Adjuster.Show
End Sub
There are about 5 of these. What is considered best practice in terms of where this code should be kept? I originally had it in a module, but have decided to move it to the ThisWorkbook object. Looking for tips on what is normally done to keep code clean.
Assuming Adjuster is the name of the form, you're using the default instance here, which isn't ideal.
This would already be better:
Dim view As Adjuster
Set view = New Adjuster
view.Show
Yes, it's more code. But you're using a dedicated object (i.e. view) and, if that object's state gets modified, these changes aren't going to affect the default instance. Think of that default instance as a global object: it's global, which isn't very OOP.
Now, you may argue, why not "new up" the object on the same line as the declaration then?
Consider this:
Sub DoSomething()
Dim c As New Collection
Set c = Nothing
c.Add "test"
End Sub
Is this code accessing a null reference and blowing up with a run-time error 91? No! Confusing? Yes! Hence, avoid the As New shortcut, unless you like having VBA automagically doing implicit stuff behind your back.
So, you're asking about best practice... I tend to consider VBA UserForms as an early pre-.NET version of winforms, and best practice design pattern for WinForms is the Model-View-Presenter pattern (aka "MVP").
Following this pattern, you'll have UserForms strictly responsible for presentation, and you'll have your business logic either implemented in a presenter object, or in a dedicated object that the presenter uses. Something like this:
Class Module: MyPresenter
The presenter class receives events from the model, and executes application logic depending on the state of the model. It knows about a concept of a view, but it doesn't have to be tightly coupled with a concrete implementation (e.g. MyUserForm) - with proper tooling you could write unit tests to validate your logic programmatically, without having to actually run the code and display the form and click everywhere.
Option Explicit
Private Type TPresenter
View As IView
End type
Public Enum PresenterError
ERR_ModelNotSet = vbObjectError + 42
End Enum
Private WithEvents viewModel As MyModel
Private this As TPresenter
Public Sub Show()
If viewModel Is Nothing Then
Err.Raise ERR_ModelNotSet, "MyPresenter.Show", "Model is not set to an object reference."
End If
'todo: set up model properties
view.Show
If Not view.IsCancelled Then DoSomething
End Sub
Public Property Get View() As IView
Set View = this.View
End Property
Public Property Set View(ByVal value As IView)
Set this.View = value
If Not this.View Is Nothing Then Set this.View.Model = viewModel
End Property
Public Property Get Model() As MyModel
Set Model = viewModel
End Property
Public Property Set Model(ByVal value As MyModel)
Set viewModel = value
If Not this.View Is Nothing Then Set this.View.Model = viewModel
End Property
Private Sub Class_Terminate()
Set this.View.Model = Nothing
Set this.View = Nothing
Set viewModel = Nothing
End Sub
Private Sub viewModel_PropertyChanged(ByVal changedProperty As ModelProperties)
'todo: execute logic that needs to run when something changes in the form
End Sub
Private Sub DoSomething()
'todo: whatever needs to happen after the form closes
End Sub
Class Module: IView
That's the abstraction that represents the concept of a View that exposes everything the Presenter needs to know about any UserForm - note that everything it needs to know, isn't much:
Option Explicit
Public Property Get Model() As Object
End Property
Public Property Set Model(ByVal value As Object)
End Property
Public Property Get IsCancelled() As Boolean
End Property
Public Sub Show()
End Sub
Class Module: MyModel
The model class encapsulates the data that the form needs and manipulates. It doesn't know about the view, and it doesn't know about the presenter either: it's just a container for encapsulated data, with simple logic that enables both the view and the presenter to execute code when any of the properties are modified.
Option Explicit
Private Type TModel
MyProperty As String
SomeOtherProperty As String
'todo: wrap members here
End Type
Public Enum ModelProperties
MyProperty
SomeOtherProperty
'todo: add enum values here for each monitored property
End Enum
Public Event PropertyChanged(ByVal changedProperty As ModelProperties)
Private this As TModel
Public Property Get MyProperty() As String
MyProperty = this.MyProperty
End Property
Public Property Let MyProperty(ByVal value As String)
If this.MyProperty <> value Then
this.MyProperty = value
RaiseEvent PropertyChanged(MyProperty)
End If
End Property
Public Property Get SomeOtherProperty() As String
SomeProperty = this.SomeOtherProperty
End Property
Public Property Let SomeOtherProperty(ByVal value As String)
If this.SomeOtherProperty <> value Then
this.SomeOtherProperty = value
RaiseEvent PropertyChanged(SomeOtherProperty)
End If
End Property
'todo: expose other model properties
UserForm: MyUserForm
The UserForm is strictly responsible for visual presentation; all its event handlers to, is change the value of a property in the model - the model then tells the presenter "hey I've been modified!", and the presenter acts accordingly. The form also listens for modified properties on the model, so when the presenter changes the model, the view can execute code and update itself accordingly. Here's an example of a simple form "binding" the MyProperty model property to the text of some TextBox1; I added a listener for SomeOtherProperty just to illustrate that the view can also be updated indirectly when the model changes.
Obviously the view wouldn't be reacting to the same properties changing as the presenter, otherwise you would enter an endless ping-pong of callbacks that would eventually blow up the stack... but you get the idea.
Note that the form implements the IView interface, so that the presenter can talk to it without actually knowing about its inner workings. The interface implementation simply refers to concrete members, but the concrete members don't even need to actually exist, since they won't even be used!
Option Explicit
Implements IView
Private Type TView
IsCancelled As Boolean
End Type
Private WithEvents viewModel As MyModel
Private this As TView
Private Property Get IView_Model() As Object
Set IView_Model = Model
End Property
Private Property Set IView_Model(ByVal value As Object)
Set Model = value
End Property
Private Property Get IView_IsCancelled() As Boolean
IView_IsCancelled = IsCancelled
End Property
Private Sub IView_Show()
Show vbModal
End Sub
Public Property Get Model() As MyModel
Set Model = viewModel
End Property
Public Property Set Model(ByVal value As MyModel)
Set viewModel = value
End Property
Public Property Get IsCancelled() As Boolean
IsCancelled = this.IsCancelled
End Property
Private Sub CancelButton_Click()
this.IsCancelled = True
Me.Hide
End Sub
Private Sub OkButton_Click()
Me.Hide
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'"x-ing out" of the form is like clicking the Cancel button
If CloseMode = VbQueryClose.vbFormControlMenu Then
this.IsCancelled = True
End If
End Sub
Private Sub UserForm_Activate()
If viewModel Is Nothing Then
MsgBox "Model property must be assigned before the view can be displayed.", vbCritical, "Error"
Unload Me
Else
Me.TextBox1.Text = viewModel.MyProperty
Me.TextBox1.SetFocus
End If
End Sub
Private Sub TextBox1_Change()
'UI elements update the model properties
viewModel.MyProperty = Me.TextBox1.Text
End Sub
Private Sub viewModel_PropertyChanged(ByVal changedProperty As ModelProperties)
If changedProperty = SomeOtherProperty Then
Frame1.Caption = SomeOtherProperty
End If
End Sub
Module: Macros
Say your spreadsheet had a shape and you wanted to run that logic when it's clicked. You need to attach a macro to that shape - I like to regroup all macros in a standard module (.bas) called "Macros", that contains nothing but public procedures that all look like this:
Option Explicit
Public Sub DoSomething()
Dim presenter As MyPresenter
Set presenter = New MyPresenter
Dim theModel As MyModel
Set theModel = New MyModel
Dim theView As IView
Set theView = New MyUserForm
Set presenter.Model = theModel
Set presenter.View = theView
presenter.Show
End Sub
Now, if you want to test your presenter logic programmatically without showing a form, all you need to do is implement a "fake" view, and write a test method that will do what you need:
Class: MyFakeView
Option Explicit
Implements IView
Private Type TFakeView
IsCancelled As Boolean
End Type
Private this As TFakeView
Private Property Get IView_Model() As Object
Set IView_Model = Model
End Property
Private Property Set IView_Model(ByVal value As Object)
Set Model = value
End Property
Private Property Get IView_IsCancelled() As Boolean
IView_IsCancelled = IsCancelled
End Property
Private Sub IView_Show()
IsCancelled = False
End Sub
Public Property Get IsCancelled() As Boolean
IsCancelled = this.IsCancelled
End Property
Public Property Let IsCancelled(ByVal value As Boolean)
this.IsCancelled = value
End Property
Module: TestModule1
There are probably other tools out there, but since I actually wrote this one and I like how it works without a crap ton of boilerplate setup code or comments that contain executable instructions I'm going to warmly recommend using Rubberduck unit tests. Here's what a [very simple] test module might look like:
'#TestModule
Option Explicit
Option Private Module
Private Assert As New Rubberduck.AssertClass
'#TestMethod
Public Sub Model_SomePropertyInitializesEmpty()
On Error GoTo TestFail
'Arrange
Dim presenter As MyPresenter
Set presenter = New MyPresenter
Dim theModel As MyModel
Set theModel = New MyModel
Set presenter.Model = theModel
Set presenter.View = New MyFakeView
'Act
presenter.Show
'Assert
Assert.IsTrue theModel.SomeProperty = vbNullString
TestExit:
Exit Sub
TestFail:
Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub
Rubberduck unit tests allow you to use this decoupled code to test everything you want to test about your application logic - as long as you keep that application logic decoupled and that you write testable code, you'll have unit tests that document how your VBA application is supposed to behave, tests that document what the specs are - just like you would have them in C# or Java, or any other OOP language one can write unit tests with.
Point is, VBA can do it, too.
Overkill? Depends. Specs changes all the time, code changes accordingly. Implementing all the application logic in spreadsheets' code-behind gets utterly annoying, because the Project Explorer doesn't drill down to module members, so finding what's implemented where can easily get annoying.
And it's even worse when the logic is implemented in the forms' code-behind and then you have Button_Click handlers making database calls or spreadsheet manipulations.
Code that's implemented in objects that have as few responsibilities as possible, makes code that's reusable, and that's easier to maintain.
Your question isn't exactly precise about exactly what you mean with "an Excel file with multiple userforms", but if you need to, you could have a "main" presenter class that receives 4-5 "child" presenters, each being responsible for the specific logic tied to each "child" form.
That said, if you have working code (that works exactly as intended) that you would like to refactor and make more efficient, or easier to read/maintain, you can post it on Code Review Stack Exchange, that's what that site is for.
Disclaimer: I maintain the Rubberduck project.
It depends on what launches these subs. If they are attached to a button or shape (which is what I tend to do for launching userforms) then it makes sense to put them in the module for the sheet that contains the shape. If buttons/shapes on several sheets refer to it -- put them in a general code module. I don't know if there really is a "best practice" here. The most important thing is to have consistency so that you don't have to go searching for things.

Does setting an object to nothing also set it's child objects to nothing?

Say I have an object, Email, one of whose properties is an object called EmailSkinner.
The EmailSkinner is instantiated in the class_initialize subroutine like this.
private sub class_initialize()
set EmailSkinner = new MyEmailSkinner
end sub
Must I explicitly set the EmailSkinner object to nothing in the class_terminate subroutine of Email?
private sub class_terminate()
set EmailSkinner = nothing
end sub
Or does this happen automatically when I set the Email object itself to nothing?
This is an interesting question. Your assumption is correct any object's you instantiate inside the scope of the parent class will be released when the parent class is released from memory.
However as with all object instantiation in VBScript (and by extension Classic ASP) there is nothing wrong with explicitly releasing objects using the Class_Terminate event.
Remember though that "scope" is important here.
If your EmailSkinner object reference is declared outside of the parent class (regardless of whether it is instantiated inside the class) the reference will remain and will require Class_Terminate() to force the object reference to be released.
Examples
Object Reference is declared inside Class scope.
Class ParentObject
Private _ChildObject
Private Sub Class_Initialize()
Set _Object = new ChildObject()
End Sub
End Class
Object Reference is declared outside Class scope (wouldn't recommend this approach).
Dim GlobalObject
Class ParentObject
Private Sub Class_Initialize()
Set GlobalObject = new ChildObject()
End Sub
'GlobalObject reference will remain so we need to
'force it to be released.
Private Sub Class_Terminate()
Set GlobalObject = Nothing
End Sub
End Class
By default, Class objects are auto destroyed, but if you create new objects outside, you will need to release them from memory .
Is always recommended that we clean memory in all scenarios .
I made a small piece of code for you to test ( I hope this would be similar to what you are trying to explain, since you didn't show us your code ) .
This code help us to check if something remains in memory after some steps of execution and declaration ( just take out the apostrophes at bottom to test the code ) :
Class EmailSkinner
public color
public size
Private Sub Class_Initialize
color = "blue"
size = 300
End Sub
End Class
Class Email
public details
public name
Private Sub Class_Initialize
Set details = New EmailSkinner '//Module Scope
End Sub
Private Sub Class_Terminate
Set details = Nothing
End Sub
End Class
Set email1 = New Email '//Global Scope
With email1
.details.color = "black"
.details.size = 400
End With
''//Take out the apostrophe to test one of the next lines
'Response.Write email1.details.color '//ASP only
'wscript.echo email1.details.color '//Wscript only
Set email1 = Nothing

VBA: evaluation order

when VBA executes this line:
GetClass1().Test(GetParam())
the GetParam function is evaluated before the GetClass1() call.
What is a good way to change this behaviour?
the only thing I came up with is this workaround:
With GetClass1
.Test(GetParam())
End With
here's the full example code, so that you can easily test it:
Class1
Option Explicit
Public Function Test(ByVal sText As String) As String
Debug.Print "Class1.Text: " & sText
Test = "Class1.Text: " & sText
End Function
Module1
Option Explicit
Private Function GetClass1() As Class1
Set GetClass1 = New Class1
Debug.Print "GetClass1()"
End Function
Private Function GetParam() As String
GetParam = "Param"
Debug.Print "GetParam()"
End Function
Private Sub Test()
Debug.Print "Test=" + GetClass1().Test(GetParam())
With GetClass1
Debug.Print "TestWith=" + .Test(GetParam())
End With
End Sub
Output when you run Test()
GetParam()
GetClass1()
Class1.Text: Param
Test=Class1.Text: Param
GetClass1()
GetParam()
Class1.Text: Param
TestWith=Class1.Text: Param
The evaluation order here is ok i think. The calling order of nested functions is from the inner most one to the outer most one which can't be done differently because outer most function needs to know its arguments and this arguments are evalueted only after the inner function was executed.
In your code (the first way) the object of type Class1 is created after the function GetParam() was called and this is because the object is created at the moment when function GetClass1() is called. In the second way with With GetClass1 the object is created immedialtelly after With and the call stack looks differently indeed.
What you can do is to create another class say 'Wrap' and this class will be responsible for creation of instance of type Class1.
E.g. like this:
' Class module Wrap
Private m_class1 As Class1
Public Function GetClass1() As Class1
Set GetClass1 = m_class1
Debug.Print "GetClass1()"
End Function
Private Sub Class_Initialize()
Set m_class1 = New Class1
End Sub
' Module code
Private Function GetParam() As String
GetParam = "Param"
Debug.Print "GetParam()"
End Function
Private Sub Test()
Dim wp As Wrap
Set wp = New Wrap
Debug.Print "Test=" + wp.GetClass1().Test(GetParam())
Debug.Print "---------------------------------------"
With New Wrap
Debug.Print "TestWith=" + .GetClass1.Test(GetParam())
End With
End Sub
Here the instance of class Class1 is created exactly at the moment you call New for class Wrap. So Set wp = New Wrap executes and creates the instance and the same way works With New Wrap, it executes and creates the instance as well.
But do not do it like this:
Dim wp As New Wrap
... then you will have the same behaviour like you had when the function GetClass1() was part of the Module1, which is: 'the instance is not created until it is needed' so you do not have the control of the moment of creation. HTH

Concepts of Runtime Polymorphism in vb.net

Consider the following example in VB.NET
Module Module1
Sub Main()
Dim myCycle As Cycle
'Here I am making a Superclass reference to hold a subclass object
myCycle = New SportsCycle()
Console.WriteLine("----Cycle Details--------")
'Using this Object I am accessing the property Wheels of the Superclass Cycle
Console.WriteLine("Number Of Wheels: " & myCycle.Wheels)
'Using this Object I am accessing the property getTyp of the Subclass Cycle
Console.WriteLine("Type Of Cycle: " & myCycle.getTyp) 'Line #1(This Line is showing error)
Console.WriteLine("--------------------------")
Console.ReadKey()
End Sub
End Module
Public Class Cycle
Private num_of_wheels As Integer
Property Wheels As Integer
Get
Return num_of_wheels
End Get
Set(ByVal value As Integer)
num_of_wheels = value
End Set
End Property
End Class
Public Class SportsCycle
Inherits Cycle
Private type As String
Sub New()
type = "RAZORBIKE"
Wheels = 2
End Sub
ReadOnly Property getTyp As String
Get
Return type
End Get
End Property
End Class
The above program is showing an error which states that "'getTyp' is not a member of
Question.Cycle in Line # 1" here 'Question' is my Project name.
Kindly clarify this concept to me. What needs to be done?
Try:
DirectCast(myCycle, SportsCycle).getTyp
The reason for this is that Cycle does not contain this property where as SportsCycle does. As SportsCycle inherits from Cycle, you can cast to SportsCycle to access the property.