VBA Class Inheritance - vba

I am working on a script to help me create geometry in 3D software based on user input and I wanted to approach the problem with classes. I have 3 levels of structures, points, curves and surfaces so I want to create a class for each, where the next level structure inherits the lower one.
So for example class cPoint have 4 properties: x,y,z,id. Further, the class cCurve has only 2 properties: id and points, and the same for surfaces.
Now my question is: I implemented class cPoint as follows:
Private x_ As Double
Private y_ As Double
Private z_ As Double
Private id_ As Long
Public Property Let X(ByVal value As Double)
x_ = value
End Property
Public Property Let Y(ByVal value As Double)
y_ = value
End Property
Public Property Let Z(ByVal value As Double)
z_ = value
End Property
Public Property Let ID(ByVal value As Long)
id_ = value
End Property
Public Property Get X() As Double
X = x_
End Property
Public Property Get Y() As Double
Y = y_
End Property
Public Property Get Z() As Double
Z = z_
End Property
Public Property Get ID() As Long
ID = id_
End Property
and everything is fine here. And here I have class cCurve implemented:
Implements cPoint
Private id_ As Long
Private point_ As Collection
Public Property Let ID(ByVal value As Long)
id_ = value
End Property
Public Property Set point(ByVal value As Collection)
Set point_ = value
End Property
Public Property Get ID() As Long
ID = id_
End Property
Public Property Get point() As Collection
Set point = point_
End Property
But here, when I try to run the code I get prompted with the following error:
Object module needs to implement 'X' for interface 'cPoint'
I think I know what it means, but I have no clue how to implement it. Is my approach even correct?
I'd highly appreciate any guidance in this manner.

VBA does not support inheritance. The only way to mimic inheritance is to implement your Point class and at the same time have a private instance of the Point class in your curve class. This is what your "Point" class would look like (I used "GeometryPoint" as the name of the class because Excel already has a "Point" class created):
Option Explicit
Private Type TState
ID As Long
X As Double
Y As Double
Z As Double
End Type
Private This As TState
Public Property Let ID(ByVal Value As Long)
This.ID = Value
End Property
Public Property Get ID() As Long
ID = This.ID
End Property
Public Property Let X(ByVal Value As Double)
This.X = Value
End Property
Public Property Get X() As Double
X = This.X
End Property
Public Property Let Y(ByVal Value As Double)
This.Y = Value
End Property
Public Property Get Y() As Double
Y = This.Y
End Property
Public Property Let Z(ByVal Value As Double)
This.Z = Value
End Property
Public Property Get Z() As Double
Z = This.Z
End Property
And this is what your "Curve" class would look like:
Option Explicit
Implements GeometryPoint
Private Type TState
Base As GeometryPoint
ID As Long
Points As Collection
X As Double
Y As Double
Z As Double
End Type
Private This As TState
Public Property Let GeometryPoint_ID(ByVal Value As Long)
This.Base.ID = Value
End Property
Public Property Get GeometryPoint_ID() As Long
GeometryPoint_ID = This.Base.ID
End Property
Public Property Let GeometryPoint_X(ByVal Value As Double)
This.Base.X = Value
End Property
Public Property Get GeometryPoint_X() As Double
GeometryPoint_X = This.Base.X
End Property
Public Property Let GeometryPoint_Y(ByVal Value As Double)
This.Base.Y = Value
End Property
Public Property Get GeometryPoint_Y() As Double
GeometryPoint_Y = This.Base.Y
End Property
Public Property Let GeometryPoint_Z(ByVal Value As Double)
This.Base.Z = Value
End Property
Public Property Get GeometryPoint_Z() As Double
GeometryPoint_Z = This.Base.Z
End Property
Public Property Set Points(ByVal Value As Collection)
Set This.Points = Value
End Property
Public Property Get Points() As Collection
Set Points = This.Points
End Property
Private Sub Class_Initialize()
Set This.Base = New GeometryPoint
End Sub
Private Sub Class_Terminate()
Set This.Base = Nothing
End Sub
In VBA, when you "Implement" a class you need to list all of the members (properties, methods) of that class. In your case you received an error because you didn't list the X,Y,Z properties of the cPoint class that you were implementing.
Is the "Curve" class supposed to have X,Y,Z properties as well? If not then you shouldn't implement the Point class. If the Curve class is just a class that stores a collection of Points then your Curve class should look like this:
**Note: This code was edited to include the "Class_Initialize" method which sets the "Points" member as a new collection once the Curve class is instantiated.
Option Explicit
Private Type TState
ID As Long
Points As Collection
End Type
Private This As TState
Public Property Let ID(ByVal Value As Long)
This.ID = Value
End Property
Public Property Get ID() As Long
ID = This.ID
End Property
Public Property Set Points(ByVal Value As Collection)
Set This.Points = Value
End Property
Public Property Get Points() As Collection
Set Points = This.Points
End Property
Private Sub Class_Initialize()
Set This.Points = New Collection
End Sub
Private Sub Class_Terminate()
Set This.Points = Nothing
End Sub
Finally, adding a new Point object to the "Points" member in the Curve class would look something like this:
Dim NewPoint As GeometryPoint
Dim NewCurve As Curve
Set NewPoint = New GeometryPoint
With NewPoint
.X = 1
.Y = 2
.Z = 3
End With
Set NewCurve = New Curve
With NewCurve.Points
.Add NewPoint
End With

Related

Advantage or Disadvantage between Two Class Modules

What would be the advantages or disadvantages of using Class1 instead of Class2?
The quantity information stored in each instance of the class will be adjusted up and down as needed (via the functions, and while it seems to make sense to me that I would only need to make these variables public so that they are visible from outside the class, I feel that there is most likely some reason that this shouldn't been done.
Class1
Option Explicit
Public Sequence As String
Public Quantity As Double
Public Sub AddQty(sAddQty As Double)
Quantity = Quantity + AddQty
End Sub
Public Sub SubQty(sSubQty As Double)
Quantity = Quantity - sSubQty
End Sub
Class2
Option Explicit
Private iSeq As String
Private iQty As Double
Public Property Get Qty() As Double
Qty = iQty
End Property
Public Property Let Qty(lQty As Double)
iQty = lQty
End Property
Public Property Get Sequence() As String
Sequence = iSeq
End Property
Public Property Let Sequence(lSeq As String)
iSeq = lSeq
End Property
Public Sub AddQty(sAddQty As Double)
iQty = iQty + AddQty
End Sub
Public Sub SubQty(sSubQty As Double)
iQty = iQty - sSubQty
End Sub
In terms of interfaces, the two are exactly equivalent, because public fields are exposed as Property members. If you added a 3rd class module and wrote this:
Implements Class1
You would be forced by the compiler to add these members:
Private Property Get Class1_Sequence() As String
End Property
Private Property Let Class1_Sequence(ByVal RHS As String)
End Property
Private Property Get Class1_Quantity() As Double
End Property
Private Property Let Class1_Quantity(ByVal RHS As Double)
End Property
Private Sub Class1_AddQty(sAddQty As Double)
End Sub
Private Sub Class1_SubQty(sSubQty As Double)
End Sub
If you added another class module and wrote this:
Implements Class2
You would be forced by the compiler to have essentially the exact same members:
Private Property Get Class2_Sequence() As String
End Property
Private Property Let Class2_Sequence(ByVal RHS As String)
End Property
Private Property Get Class2_Qty() As Double
End Property
Private Property Let Class2_Qty(ByVal RHS As Double)
End Property
Private Sub Class2_AddQty(sAddQty As Double)
End Sub
Private Sub Class2_SubQty(sSubQty As Double)
End Sub
When properties do nothing and there's no incentive to properly encapsulate their values, go ahead and have public fields.
However there's little need for AddQty or SubQty instance methods when the backing field exposes a Property Let accessor - one could simply do foo.Quantity = foo.Quantity + 2 instead. An API that appears to provide multiple ways to do the same thing, is a confusing API.
So what you do, is you define an explicit interface that defines the API you want to work with:
Public Property Get Quantity() As Double
End Property
Public Property Get Sequence() As String
End Property
Public Sub AddQty(ByVal value As Double)
End Sub
Public Sub SubQty(ByVal value As Double)
End Sub
And then make your class Implements this interface (say, ISomething), and the rest of the code works with this ISomething interface that only exposes the members you want it to be able to work with - and that excludes the class' Property Let members; the rest of the code only sees what it needs to see, and can only access what it needs to access.
Dim foo As ISomething
Set foo = New Something
'foo.Quantity = 42 ' illegal
Dim bar As Something
Set bar = foo
bar.Quantity = 42 ' ok
bar.AddQty 2
Debug.Print foo.Quantity ' should be 44

Putting dictionaries into classes

I was given an answer on how to make a general class module: Class "let" stuck in infinite loop
I'm trying to apply this to dictionaries inside my classes.
My class module:
Option Explicit
Private Type categories
Temp As scripting.Dictionary
Humid As scripting.Dictionary
Wind As scripting.Dictionary
End Type
Private this As categories
Public Sub Initialize()
Set this.Temp = New scripting.Dictionary
Set this.Humid = New scripting.Dictionary
Set this.Wind = New scripting.Dictionary
End Sub
Public Property Get Temp(ByVal HourIndex As Long) As Double
Temp = this.Temp(HourIndex)
End Property
Public Property Let Temp(ByVal HourIndex As Long, ByVal Value As Double)
this.Temp(HourIndex) = Value
End Property
Public Property Get Humid(ByVal HourIndex As Long) As Double
Humid = this.Humid(HourIndex)
End Property
Public Property Let Humid(ByVal HourIndex As Long, ByVal Value As Double)
this.Humid(HourIndex) = Value
End Property
Public Property Get Wind(ByVal HourIndex As Long) As Double
Wind = this.Wind(HourIndex)
End Property
Public Property Let Wind(ByVal HourIndex As Long, ByVal Value As Double)
this.Wind(HourIndex) = Value
End Property
I tried to test this in the immediate window with set tester = new WeatherData (the name of the module) and Initialize. That did not work.
I then modified Initialize:
Public Sub Initialize(ByVal variable As categories)
Set variable.Temp = New scripting.Dictionary
Set variable.Humid = New scripting.Dictionary
Set variable.Wind = New scripting.Dictionary
End Sub
and entered Initialize tester, but this did not work either ("Compile Error: Sub or Function not defined").
How do I put three dictionaries in a class module?
The following doesn't solve the problem, but it did skirt around it to the point that I don't have to acknowledge it:
Option Explicit
Private Type categories
Temp(23) As Double
Humid(23) As Double
wind(23) As Double
End Type
Private this As categories
Public Property Get Temp(ByVal HourIndex As Long) As Double
Temp = this.Temp(HourIndex)
End Property
Public Property Let Temp(ByVal HourIndex As Long, ByVal Value As Double)
this.Temp(HourIndex) = Value
End Property
Public Property Get Humid(ByVal HourIndex As Long) As Double
Humid = this.Humid(HourIndex)
End Property
Public Property Let Humid(ByVal HourIndex As Long, ByVal Value As Double)
this.Humid(HourIndex) = Value
End Property
Public Property Get wind(ByVal HourIndex As Long) As Double
wind = this.WindChill(HourIndex)
End Property
Public Property Let wind(ByVal HourIndex As Long, ByVal Value As Double)
this.wind(HourIndex) = Value
End Property
tl;dr: make arrays instead of dictionaries, and cut out initialize entirely. Your "keys" have no choice but to be numbers, but it works. I would be interested in knowing an actual solution, but the specific issue is solved.
Seems you want to implement an indexed property.
Simplified to a bare minimum:
Option Explicit
Private values As Scripting.Dictionary
Private Sub Class_Initialize()
Set values = New Scripting.Dictionary
End Sub
Public Property Get Something(ByVal key As String) As Double
Something = values(key)
End Property
Public Property Let Something(ByVal key As String, ByVal value As Double)
values(key) = value
End Property
You keep the dictionaries safely encapsulated as an implementation detail of your class (external code cannot set them to Nothing, for example), and expose an indexed Get+Let property for each encapsulated dictionary, that takes the index (/key) as a parameter.
In the case of your WeatherData class, this means you can populate the data like this:
Set data = New WeatherData
With data
.Temp("day 1") = 76
.Temp("day 2") = 78
.Humid("day 1") = 0.55
.Humid("day 2") = 0.61
.Wind("day 1") = 0.92
.Wind("day 2") = 1.27
End With
And then retrieve the temperature of "day 1" with data.Temp("day 1").
As for your initializer method, it needed to be called from an instance of the class - being an instance method.
So instead of Initialize tester you should have done tester.Initialize.
Whether you make the internal encapsulated storage an array, a Collection or a Dictionary makes no difference to the calling code - it's an encapsulated implementation detail: your class could just as well store the data in .csv files or into a database if it wanted.
I've found Mathieu Guindon example very instructive but quite minimalist for beginners.
All credits for Mathieu Guindon, but let me share an extended version of his code, using late binding just to change little details.
Class code module named WeatherData:
'Mathieu Guindon,Feb 6 '17
'https://stackoverflow.com/a/43263480
Option Explicit
Private dTemp As Object
Private dHumid As Object
Private dWind As Object
Private Sub Class_Initialize()
Set dTemp = CreateObject("Scripting.Dictionary")
Set dHumid = CreateObject("Scripting.Dictionary")
Set dWind = CreateObject("Scripting.Dictionary")
End Sub
Public Property Get Temp(ByVal key As String) As Double
Temp = dTemp(key)
End Property
Public Property Let Temp(ByVal key As String, ByVal value As Double)
dTemp(key) = value
End Property
Public Property Get TempItemCount() As Long
TempItemCount = dTemp.Count
End Property
Public Property Get Humid(ByVal key As String) As Double
Humid = dHumid(key)
End Property
Public Property Let Humid(ByVal key As String, ByVal value As Double)
dHumid(key) = value
End Property
Public Property Get HumidItemCount() As Long
HumidItemCount = dHumid.Count
End Property
Public Property Get Wind(ByVal key As String) As Double
Wind = dWind(key)
End Property
Public Property Let Wind(ByVal key As String, ByVal value As Double)
dWind(key) = value
End Property
Public Property Get WindItemCount() As Long
WindItemCount = dWind.Count
End Property
Standar code module:
Sub test()
Set Data = New WeatherData
With Data
.Temp("day 1") = 76
.Temp("day 2") = 78
.Humid("day 1") = 0.55
.Humid("day 2") = 0.61
.Wind("day 1") = 0.92
.Wind("day 2") = 1.27
Debug.Print .Temp("day 2")
Debug.Print .Humid("day 2")
Debug.Print .Wind("day 2")
Debug.Print .Wind("day 2")
Debug.Print .TempItemCount
End With
End Sub
In this case you should use late binding as follows:
Private Type categories
Temp As Object
Humid As Object
Wind As Object
End Type
Private this As categories
Public Sub Initialize()
Set this.Temp = CreateObject("Scripting.Dictionary")
Set this.Humid = CreateObject("Scripting.Dictionary")
Set this.Wind = CreateObject("Scripting.Dictionary")
End Sub
Furthermore you can't use Let with multiple arguments. You should use a function to do that:
Public Function SetTemp(ByVal HourIndex As Long, ByVal Value As Double)
this.Temp(HourIndex) = Value
End Function
To run this I used:
Sub test()
Dim multi As Dictionaries
Set multi = New Dictionaries
multi.Initialize
multi.SetTemp 13, 25.522
Debug.Print multi.Temp(13)
End Sub
Where my class module is named Dictionaries. So basically use late binding and change all your multi argument let functions to simple functions.

Saving Control Values to Class Object Property

I have this userform that I has a bunch of controls on it, and the control name corresponds to a property name that i have defined inside OrderPrompts.
When the user clicks on the save button, I am trying to save all those control values back to the original object OrderPrompts.
Here's the order prompts classs
Option Explicit
Private pSKU As String
Private pWidth As String
Private pHeight As String
Private pDepth As String
Private pLeftSwing As String
Private pRightSwing As String
Private pLeftFinishedEnd As String
Private pRightFinishedEnd As String
Private pToeKickHeight As String
Private pAdjShelfQty As String
Private pLeftStileWidth As String
Private pRightStileWidth As String
Private pTopRailWidth As String
Private pBottomRailWidth As String
Private pExtendLeftFFDown As String
Private pExtendLeftFFUp As String
Private pExtendRightFFDown As String
Private pExtendRightFFUp As String
Private pExtendTopRail As String
Private pExtendBottomRail As String
Private pBayHeightCalc As String
Private pBay1Height As String
Private pBay2Height As String
Private pBay3Height As String
Private pBay4Height As String
Private pBay5Height As String
Private pBayWidthCalc As String
Private pBay1Width As String
Private pBay2Width As String
Private pBay3Width As String
Private pBay4Width As String
Private pBay5Width As String
Private pDrawerFrontCalc As String
Private pTopDrawerFront As String
Private pSecondDrawerFront As String
Private pThirdDrawerFront As String
Private pBottomDrawerFront As String
Public Property Get SKU() As String
SKU = pSKU
End Property
Public Property Let SKU(Value As String)
pSKU = Value
End Property
Public Property Get Width() As String
Width = pWidth
End Property
Public Property Let Width(Value As String)
pWidth = Value
End Property
Public Property Get Height() As String
Height = pHeight
End Property
Public Property Let Height(Value As String)
pHeight = Value
End Property
Public Property Get Depth() As String
Depth = pDepth
End Property
Public Property Let Depth(Value As String)
pDepth = Value
End Property
Public Property Get LeftSwing() As String
LeftSwing = pLeftSwing
End Property
Public Property Let LeftSwing(Value As String)
pLeftSwing = Value
End Property
Public Property Get RightSwing() As String
RightSwing = pRightSwing
End Property
Public Property Let RightSwing(Value As String)
pRightSwing = Value
End Property
Public Property Get LeftFinishedEnd() As String
LeftFinishedEnd = pLeftFinishedEnd
End Property
Public Property Let LeftFinishedEnd(Value As String)
pLeftFinishedEnd = Value
End Property
Public Property Get RightFinishedEnd() As String
RightFinishedEnd = pRightFinishedEnd
End Property
Public Property Let RightFinishedEnd(Value As String)
pRightFinishedEnd = Value
End Property
Public Property Get ToeKickHeight() As String
ToeKickHeight = pToeKickHeight
End Property
Public Property Let ToeKickHeight(Value As String)
pToeKickHeight = Value
End Property
Public Property Get AdjShelfQty() As String
AdjShelfQty = pAdjShelfQty
End Property
Public Property Let AdjShelfQty(Value As String)
pAdjShelfQty = Value
End Property
Public Property Get LeftStileWidth() As String
LeftStileWidth = pLeftStileWidth
End Property
Public Property Let LeftStileWidth(Value As String)
pLeftStileWidth = Value
End Property
Public Property Get RightStileWidth() As String
RightStileWidth = pRightStileWidth
End Property
Public Property Let RightStileWidth(Value As String)
pRightStileWidth = Value
End Property
Public Property Get TopRailWidth() As String
TopRailWidth = pTopRailWidth
End Property
Public Property Let TopRailWidth(Value As String)
pTopRailWidth = Value
End Property
Public Property Get BottomRailWidth() As String
BottomRailWidth = pBottomRailWidth
End Property
Public Property Let BottomRailWidth(Value As String)
pBottomRailWidth = Value
End Property
Public Property Get ExtendLeftFFDown() As String
ExtendLeftFFDown = pExtendLeftFFDown
End Property
Public Property Let ExtendLeftFFDown(Value As String)
pExtendLeftFFDown = Value
End Property
Public Property Get ExtendLeftFFUp() As String
ExtendLeftFFUp = pExtendLeftFFUp
End Property
Public Property Let ExtendLeftFFUp(Value As String)
pExtendLeftFFUp = Value
End Property
Public Property Get ExtendRightFFDown() As String
ExtendRightFFDown = pExtendRightFFDown
End Property
Public Property Let ExtendRightFFDown(Value As String)
pExtendRightFFDown = Value
End Property
Public Property Get ExtendRightFFUp() As String
ExtendRightFFUp = pExtendRightFFUp
End Property
Public Property Let ExtendRightFFUp(Value As String)
pExtendRightFFUp = Value
End Property
Public Property Get ExtendTopRail() As String
ExtendTopRail = pExtendTopRail
End Property
Public Property Let ExtendTopRail(Value As String)
pExtendTopRail = Value
End Property
Public Property Get ExtendBottomRail() As String
ExtendBottomRail = pExtendBottomRail
End Property
Public Property Let ExtendBottomRail(Value As String)
pExtendBottomRail = Value
End Property
Public Property Get BayHeightCalc() As String
BayHeightCalc = pBayHeightCalc
End Property
Public Property Let BayHeightCalc(Value As String)
pBayHeightCalc = Value
End Property
Public Property Get Bay1Height() As String
Bay1Height = pBay1Height
End Property
Public Property Let Bay1Height(Value As String)
pBay1Height = Value
End Property
Public Property Get Bay2Height() As String
Bay2Height = pBay2Height
End Property
Public Property Let Bay2Height(Value As String)
pBay2Height = Value
End Property
Public Property Get Bay3Height() As String
Bay3Height = pBay3Height
End Property
Public Property Let Bay3Height(Value As String)
pBay3Height = Value
End Property
Public Property Get Bay4Height() As String
Bay4Height = pBay4Height
End Property
Public Property Let Bay4Height(Value As String)
pBay4Height = Value
End Property
Public Property Get Bay5Height() As String
Bay5Height = pBay5Height
End Property
Public Property Let Bay5Height(Value As String)
pBay5Height = Value
End Property
Public Property Get BayWidthCalc() As String
BayWidthCalc = pBayWidthCalc
End Property
Public Property Let BayWidthCalc(Value As String)
pBayWidthCalc = Value
End Property
Public Property Get Bay1Width() As String
Bay1Width = pBay1Width
End Property
Public Property Let Bay1Width(Value As String)
pBay1Width = Value
End Property
Public Property Get Bay2Width() As String
Bay2Width = pBay2Width
End Property
Public Property Let Bay2Width(Value As String)
pBay2Width = Value
End Property
Public Property Get Bay3Width() As String
Bay3Width = pBay3Width
End Property
Public Property Let Bay3Width(Value As String)
pBay3Width = Value
End Property
Public Property Get Bay4Width() As String
Bay4Width = pBay4Width
End Property
Public Property Let Bay4Width(Value As String)
pBay4Width = Value
End Property
Public Property Get Bay5Width() As String
Bay5Width = pBay5Width
End Property
Public Property Let Bay5Width(Value As String)
pBay5Width = Value
End Property
Public Property Get DrawerFrontCalc() As String
DrawerFrontCalc = pDrawerFrontCalc
End Property
Public Property Let DrawerFrontCalc(Value As String)
pDrawerFrontCalc = Value
End Property
Public Property Get TopDrawerFront() As String
TopDrawerFront = pTopDrawerFront
End Property
Public Property Let TopDrawerFront(Value As String)
pTopDrawerFront = Value
End Property
Public Property Get SecondDrawerFront() As String
SecondDrawerFront = pSecondDrawerFront
End Property
Public Property Let SecondDrawerFront(Value As String)
pSecondDrawerFront = Value
End Property
Public Property Get ThirdDrawerFront() As String
ThirdDrawerFront = pThirdDrawerFront
End Property
Public Property Let ThirdDrawerFront(Value As String)
pThirdDrawerFront = Value
End Property
Public Property Get BottomDrawerFront() As String
BottomDrawerFront = pBottomDrawerFront
End Property
Public Property Let BottomDrawerFront(Value As String)
pBottomDrawerFront = Value
End Property
Here's how OrderPrompts is defined inside the form control
Public Property Get OrderPrompts() As clsOrderPromptRow
Set OrderPrompts = pOrderPrompts
End Property
Public Property Let OrderPrompts(Value As clsOrderPromptRow)
Set pOrderPrompts = Value
End Property
Here's the code I have for the button click
Private Sub btnSave_Click()
Dim Prompt As Control
Dim PageIndex As Long
For PageIndex = 0 To Me.TabControl.Pages.Count - 1
For Each Prompt In TabControl.Pages(PageIndex).Controls
'MsgBox (TypeName(Prompt))
'CallByName(Me.ProductPromptMapping, PromptControl.ControlName, VbGet)
Select Case TypeName(Prompt)
Case "TextBox"
CallByName Me.OrderPrompts, Prompt.Name, VbLet, Prompt.Text
Case "OptionButton"
CallByName Me.OrderPrompts, Prompt.Name, VbLet, Prompt.ControlFormat.Value
Case "CheckBox"
CallByName Me.OrderPrompts, Prompt.Name, VbLet, CStr(Prompt.Value)
Case "ComboBox"
CallByName Me.OrderPrompts, Prompt.Name, VbLet, Prompt.Value
End Select
Next
Next
MsgBox (OrderPrompts.Width)
Me.Hide
End Sub
The problem i am having is with saving the Checkbox, Combobox, and OptionButton values back to the object. The textbox value works just fine. So I am not sure what to fix. I keep getting either a type mismatch error or null not supported.
Any help is appreciated. Thanks in advance.
The short answer is to use Prompt.Object.Value for all the controls.
Public Sub PrintControls()
Dim Prompt As Control
Dim PageIndex As Long
For PageIndex = 0 To Me.TabControl.Pages.Count - 1
For Each Prompt In TabControl.Pages(PageIndex).Controls
Debug.Print "Name:", Prompt.Name, "Value:", Prompt.Object.Value
Next
Next
End Sub
I really liked your concept so I wrote my own class to Save and Load control values. My class saves references to the controls and their values for easy retrieval. Download Workbook
When the Save button is clicked a reference to each control on the MultiPage is saved into a Scripting Dictionary. The Dictionary is then added to an ArrayList and the Dictionary's index in the ArrayList is added to a ListBox. When the ListBox is clicked the current settings are saved and the previous settings, corresponding to the Listbox's Value, are loaded.
Class: SettingsDictionaryClass
Option Explicit
Private ControlSetting As Object
Private mTabControl As MSForms.MultiPage
Sub Init(TabControl As MSForms.MultiPage)
Set mTabControl = TabControl
Set ControlSetting = CreateObject("System.Collections.ArrayList")
End Sub
Function Save() As Long
Dim subDict As Object: Set subDict = CreateObject("Scripting.Dictionary")
Dim ctrl As MSForms.Control
Dim PageIndex As Long
With mTabControl
For PageIndex = 0 To .Pages.Count - 1
For Each ctrl In .Pages(PageIndex).Controls
subDict.Add ctrl, ctrl.Object.Value
Next
Next
End With
Save = ControlSetting.Count
ControlSetting.Add subDict
End Function
Sub LoadValues(ListIndex As Long, Optional SaveCurrent As Boolean)
Dim ctrl
Dim Settings As Object
If SaveSetting Then Save
Set Settings = ControlSetting.Item(ListIndex)
For Each ctrl In Settings
ctrl.Value = Settings(ctrl)
Next
End Sub
Userform: Userform1
Option Explicit
Private SettingsDictionary As SettingsDictionaryClass
Private Sub btnSave_Click()
lboSettings.AddItem SettingsDictionary.Save
End Sub
Private Sub lboSettings_Click()
SettingsDictionary.LoadValues lboSettings.Value, True
End Sub
Private Sub UserForm_Initialize()
Set SettingsDictionary = New SettingsDictionaryClass
SettingsDictionary.Init TabControl
End Sub

Instantiating objects within another class in Excel VBA

I'm working on a project using Excel VBA where I have a number of datasets, each populated with a number of 'patients' which have a number of parameters (such as treatment, outcome etc.). To handle this, I intend to create a class called 'patient', with properties such as treatment and outcome. Then create a class called 'dataset', with a public property of 'patient'. I've created the classes, and I can instantiate a dataset object. But how do I go about instantiating patient object, or ideally an array of patient objects within the dataset object?
Dataset class module:
Private pNumber As Integer
Public Patient As Patient
Public Property Get Number() As Integer
Number = pNumber
End Property
Public Property Let Number(p As Integer)
pNumber = p
End Property
Patient class module:
Private pID As Integer
Private pTreatment As Boolean
Private pResponse As Single
Public Property Get ID() As Integer
ID = pID
End Property
Public Property Let ID(p As Integer)
pID = p
End Property
Public Property Get Treatment() As Boolean
Treatment = pTreatment
End Property
Public Property Let Treatment(p As Boolean)
pTreatment = p
End Property
Public Property Get Response() As Single
Response = pResponse
End Property
Public Property Let Response(p As Single)
pResponse = p
End Property
Main Module
Sub main()
Dim data1 As Dataset
Set data1 = New Dataset
'code to instantiate array of patient within data1 here
End Sub
The dataset will be better appointed something like this.
I would call the class what it is intended to be, so Patients:
private colPatients as new collection
public function add(aPatient as patient)
colPatients.add aPatient, aPatient.Id
end function
public property get count() as long
count = colPatients.count
end property
public property get items() as collection
set items = colPatients
end property
public property get item(vItem as variant) as patient
set item = colPatients(vItem)
end property
public sub remove(vItem as variant)
colPatients.remove vItem
end sub
So to use:
dim patientCollection as patients
Sub main()
Set patientCollection = New patients
'code to instantiate array of patient within data1 here
IDs = Array(1,2,3)
treats = array("x","y","z")
dim x as integer
dim p as patient
for x = lbound(IDs) to Ubound(IDs)
set p= new patient
p.id = IDs(x)
p.treatment = treats(x)
patientCollection.add p
set p = nothing
next x
End Sub

Default values of Class properties

I have a class, it looks like this:
Public Class DataPoint
Private _data As Integer
Private _locInText As Integer
Private _searchValue As String
Property Data As Integer
Get
Return _data
End Get
Set(value As Integer)
_data = value
End Set
End Property
Property LocInText As Integer
Get
Return _locInText
End Get
Set(value As Integer)
_locInText = value
End Set
End Property
Property SearchValue As String
Get
Return _searchValue
End Get
Set(value As String)
_searchValue = value
End Set
End Property
End Class
I then create another class using this class.
Public Class PaintData
Public Time As TimeSpan
Public Color As DataPoint
Public Job As New DataPoint
Public MaxCurrent As New DataPoint
End Class
I want to create default values of some of the properties, namly SearchValue and LocInText. To me, it makes sense to do this inside the class definition, because these are essentially constants.
Q1. Should I be doing it this way? If not, what is the proper technique.
Q2. I can't get the syntax right. Can you help?
Public Class PaintData
Public Time As TimeSpan
Public Color As DataPoint
Public Job As New DataPoint
Public MaxCurrent As New DataPoint
Color.LocInText = 4 '<----Declaration expected failure because I'm not in a method
Job.LocInText = 5 '<----Declaration expected failure because I'm not in a method
End Class
Thanks all
Give DataPoint a constructor:
Public Class DataPoint
Private _data As Integer
Private _locInText As Integer
Private _searchValue As String
Public Sub New(locInText as Integer)
_locInText = locInText
End Sub
'...
End Class
And use that:
Public Class PaintData
Public Time As TimeSpan
Public Color As New DataPoint(4)
Public Job As New DataPoint(5)
Public MaxCurrent As New DataPoint(6)
End Class
Alternatively you could use
Public Property Color As DataPoint = New DataPoint With {.LocInText = 4}
in your class definition. This syntax is arguably more readable than the constructor syntax.