I have a class which implements another object. I set a property function for each property of the implemented object but keep getting an 'Invalid use of property' error. Here's my code:
Test Sub:
Sub tst()
Dim a As Derived
Set a = New Derived
a.Base_name = "ALGO" 'Error happens when this executes
End Sub
Derived class module:
Option Explicit
Implements Base
Private sec As Base
Private Sub Class_Initialize()
Set sec = New Base
End Sub
Public Property Get Base_name() As String
Call sec.name
End Property
Public Property Let Base_name(value As String)
Call sec.name(value) 'Error happens here
End Property
Base Class module:
Private pname As String
Public Property Get name() As String
name = pname
End Property
Public Property Let name(value As String)
pname = value
End Property
Is this what you want?
Module1
Sub tst()
Dim a As Derived
Set a = New Derived
Debug.Print a.Base_name
a.Base_name = "ALGO"
Debug.Print a.Base_name
End Sub
Base Class Module
Private pname As String
Public Property Get name() As String
name = pname
End Property
Public Property Let name(value As String)
pname = value
End Property
Derived Class Module
Option Explicit
Implements Base
Private sec As Base
Private Sub Class_Initialize()
Set sec = New Base
End Sub
Public Property Get Base_name() As String
Base_name = sec.name
End Property
Public Property Let Base_name(value As String)
sec.name = value
End Property
Related
This question already has an answer here:
VBA inheritance pattern
(1 answer)
Closed 4 months ago.
I’m creating a set of User Defined Classes using Implements. Some (but not all) of the Properties and Methods of the implemented classes use exactly the same code in each implemented class. What I would like to do is move that code to one place, to avoid repeating myself.
An minimal example to demonstrate the requirement:
Class cMasterClass
Option Explicit
Private pMyClasses As Collection
Public Property Get Item(idx As Long)
Set Item = pMyClasses.Item(idx)
End Property
Public Property Get SomeProperty() As String
SomeProperty = "Master Class"
End Property
Public Sub AddClass(Name As String, Instance As Long)
Dim NewClass As cTemplateClass
Select Case Instance
Case 1
Set NewClass = New cMyClass1
Case 2
Set NewClass = New cMyClass2
End Select
NewClass.Init Me, Name
pMyClasses.Add NewClass, Name
End Sub
Private Sub Class_Initialize()
Set pMyClasses = New Collection
End Sub
Class cTemplateClass
Option Explicit
Public Property Get Name() As String: End Property
Public Property Get Parent() As cMasterClass: End Property
Public Property Get SomeProperty() As String: End Property
Public Sub Init(Parent As cMasterClass, Name As String): End Sub
Class cMyClass1
Option Explicit
Implements cTemplateClass
Private pParent As cMasterClass
Private pName As String
Public Property Get cTemplateClass_Name() As String: cTemplateClass_Name = pName: End Property
Public Property Get cTemplateClass_Parent() As cMasterClass: Set cTemplateClass_Parent = pParent: End Property
Public Property Get cTemplateClass_SomeProperty() As String
cTemplateClass_SomeProperty = "Some String from MyClass 1"
End Property
Public Sub cTemplateClass_Init(Parent As cMasterClass, Name As String)
Set pParent = Parent
pName = Name
End Sub
Class cMyClass2
Option Explicit
Implements cTemplateClass
Private pParent As cMasterClass
Private pName As String
Public Property Get cTemplateClass_Name() As String: cTemplateClass_Name = pName: End Property
Public Property Get cTemplateClass_Parent() As cMasterClass: Set cTemplateClass_Parent = pParent: End Property
Public Property Get cTemplateClass_SomeProperty() As String
cTemplateClass_SomeProperty = "Some String from MyClass 2"
End Property
Public Sub cTemplateClass_Init(Parent As cMasterClass, Name As String)
Set pParent = Parent
pName = Name
End Sub
Standard Module
Sub Demo()
Dim MyMasterClass As cMasterClass
Set MyMasterClass = New cMasterClass
MyMasterClass.AddClass "Example class 1", 1
MyMasterClass.AddClass "Example class 2", 2
Dim SomeInstance As cTemplateClass
Set SomeInstance = MyMasterClass.Item(1)
Debug.Print "Instance 1", SomeInstance.Name, "Parent", SomeInstance.Parent.SomeProperty
Set SomeInstance = MyMasterClass.Item(2)
Debug.Print "Instance 2", SomeInstance.Name, "Parent", SomeInstance.Parent.SomeProperty
End Sub
Notice that in cMyClass1 and cMyClass2 the code for Init, Name and Parent are identical (but SomeProperty is not)
How could I move the common code from the individual classes into one place (I know the Template class cannot contain the common code)?
How could I move the common code from the individual classes into one place (I know the Template class cannot contain the common code)?
Hi Chris, actually the Template class can contain that common code and be used with Implements to ensure that interface implementation. I am late with this answer and I am not sure if this can help you but anyway ... :). What you could consider would be to actually move the parent and name to your template class and use init to fill them and at the same time with using implements create instance of the template so your classes ensure that interface and they can redirect the code to the template at the same time. If you wish have a look here for another example. HTH, Dan
Change the child classes a bit:
Option Explicit
Implements cTemplateClass
'Move this to your template class:
'Private pParent As cMasterClass
'Private pName As String
'and declare the varaible of template class here instead:
Private pTemplate As cTemplateClass
Public Property Get cTemplateClass_Name() As String
'Redirect the property to template class instance
'cTemplateClass_Name = pName
cTemplateClass_Name = pTemplate.Name
End Property
Public Property Get cTemplateClass_Parent() As cMasterClass
'Redirect the property to template class instance
'Set cTemplateClass_Parent = pParent
Set cTemplateClass_Parent = pTemplate.Parent
End Property
Public Sub cTemplateClass_Init(Parent As cMasterClass, Name As String)
' Instantiate here the template class and redirect the Init
' Set pParent = Parent
' pName = Name
Set pTemplate = New cTemplateClass
pTemplate.Init Parent, Name
End Sub
Public Property Get cTemplateClass_SomeProperty() As String
cTemplateClass_SomeProperty = "Some String from MyClass 2"
End Property
And anhance the template class a bit too:
Option Explicit
'Move this here from your 'derived' classes:
Private pParent As cMasterClass
Private pName As String
Public Property Get Name() As String
Name = pName
End Property
Public Property Get Parent() As cMasterClass
Set Parent = pParent
End Property
Public Sub Init(Parent As cMasterClass, Name As String)
Set pParent = Parent
pName = Name
End Sub
Public Property Get SomeProperty() As String
End Property
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
Not an experienced programmer, so probably not a hard question.
Developing a small application in VB.net in WPF.
I made 3 classes, EngineeringObject<==Inherits==PartOfInstallation<==Inherits==SensorActor
In the class SensorActor I'm trying to get a property of PartOfInstallation with the function MyBase.Name. But this goes directly to EngineeringObject. How do I solve this?
Public Class EngineeringObject
''Private declarations, alleen objecten die erven kunnen hieraan, of dmv van getters en setters
'Name of part
Private sName As String = "Naam"
'81346 Id's
Private sSystemId As String = "Functie" 'VentilationSystem, Pumpsystem
Private sLocationId As String = "Locatie" 'Room 0.0
Private sObjectId As String = "Object" 'Fan, Pump
'General
Private sPartNumber As String
Private sLinkToDatasheet As String
'Property's
Public Property Name() As String
Get
Return sName
End Get
Set(ByVal value As String)
sName = value
End Set
End Property
Public Property SystemId() As String
Get
Return sSystemId
End Get
Set(ByVal value As String)
sSystemId = value
End Set
End Property
Public Property PartNumber() As String
Get
Return sPartNumber
End Get
Set(ByVal value As String)
sPartNumber = value
End Set
End Property
Public Property LinkToDatasheet() As String
Get
Return sLinkToDatasheet
End Get
Set(ByVal value As String)
sLinkToDatasheet = value
End Set
End Property
Public Sub New()
End Sub
End Class
Public Class PartOfInstallation
Inherits EngineeringObject
'src: https://stackoverflow.com/questions/21308881/parent-creating-child-object
'src: https://stackoverflow.com/questions/16244548/how-to-create-a-list-of-parent-objects-where-each-parent-can-have-a-list-of-chil
Private lSensorActor As New List(Of SensorActor)
Public Function GetSensorActor()
Return Me.lSensorActor
End Function
Public Sub CreateSensorActor()
lSensorActor.Add(New SensorActor)
End Sub
End Class
Public Class SensorActor
Inherits PartOfInstallation
Dim sMyPartOfInstallation As String
Public Property MyPartOfInstallation As String
Get
Return sMyPartOfInstallation
End Get
Set(value As String)
sMyPartOfInstallation = MyBase.Name
End Set
End Property
End Class
If I understand it correctly, based on your comments, you want every SensorActor instantiated within a PartOfInstallation instance to get the same name as that instance.
If so, then just add a second constructor to your SensorActor class allowing you to pass a name for it as well:
Public Class SensorActor
Inherits PartOfInstallation
...your code...
Public Sub New() 'Empty constructor, for if/when you don't want to set the name immediately.
End Sub
Public Sub New(ByVal Name As String)
Me.Name = Name
End Sub
End Class
Now in your PartOfInstallation class you can do:
Public Sub CreateSensorActor()
lSensorActor.Add(New SensorActor(Me.Name)) 'Here, "Me" refers to the current PartOfInstallation instance.
End Sub
Alternatively you can make the SensorActor constructor take a PartOfInstallation instance instead, allowing you to copy any properties you like:
Public Class SensorActor
Inherits PartOfInstallation
...your code...
Public Sub New()
End Sub
Public Sub New(ByVal BasedOnPOI As PartOfInstallation)
Me.Name = BasedOnPOI.Name
End Sub
End Class
Thus making the code in the PartOfInstallation class:
Public Sub CreateSensorActor()
lSensorActor.Add(New SensorActor(Me))
End Sub
Read more about constructors: Object Lifetime: How Objects Are Created and Destroyed (Visual Basic) | Microsoft Docs
The result below, if there's room for improvement... always welcome.
SensorActor
Public Class SensorActor
Inherits PartOfInstallation
Dim sTemp As String
Public Overloads Property SystemId() As String
Get
Return Me.sSystemId
End Get
Set(ByVal value As String)
Me.sSystemId = sTemp + "." + value
End Set
End Property
Public Sub New(ByVal BasedOnPOI As PartOfInstallation)
sTemp = BasedOnPOI.SystemId
End Sub
End Class
PartOfInstallation
Public Class PartOfInstallation
Inherits EngineeringObject
'src: https://stackoverflow.com/questions/21308881/parent-creating-child-object
'src: https://stackoverflow.com/questions/16244548/how-to-create-a-list-of-parent-objects-where-each-parent-can-have-a-list-of-chil
Private lSensorActor As New List(Of SensorActor)
Public Function GetSensorActor()
Return Me.lSensorActor
End Function
Public Sub CreateSensorActor()
lSensorActor.Add(New SensorActor(Me))
End Sub
End Class
EngineeringObject
Public Class EngineeringObject
''Private declarations, alleen objecten die erven kunnen hieraan, of dmv van getters en setters
'Name of part
Private sName As String = "Naam"
'81346 Id's
Friend sSystemId As String = "Functie" 'VentilationSystem, Pumpsystem
Private sLocationId As String = "Locatie" 'Room 0.0
Private sObjectId As String = "Object" 'Fan, Pump
'General
Private sPartNumber As String
Private sLinkToDatasheet As String
'Property's
Public Property Name() As String
Get
Return sName
End Get
Set(ByVal value As String)
sName = value
End Set
End Property
Public Property SystemId() As String
Get
Return sSystemId
End Get
Set(ByVal value As String)
sSystemId = "=" + value
End Set
End Property
Public Property PartNumber() As String
Get
Return sPartNumber
End Get
Set(ByVal value As String)
sPartNumber = value
End Set
End Property
Public Property LinkToDatasheet() As String
Get
Return sLinkToDatasheet
End Get
Set(ByVal value As String)
sLinkToDatasheet = value
End Set
End Property
Public Sub New()
End Sub
End Class
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
I have 2 classes
Class1
Private pClass2Arr(10) as Class2
Public Property Get class2Arr() as Class2()
class2Arr = pClass2Arr
End Property
Public Property Let class2Arr(mClass2Arr() as Class2)
pClass2Arr = mClass2Arr
End Property
Class2
Private pStr1 as String
Private pStr2 as String
Public Property Get str1() as String
str1 = pStr1
End Property
Public Property Let str1(mStr1 as String)
pStr1 = mStr1
End Property
Public Property Get str2() as String
str2 = pStr2
End Property
Public Property Let str2(mStr2 as String)
pStr2 = mStr2
End Property
And Id' like to do
Dim a as Class1
Set a = New Class1
a.class2Arr(0).str1 = "test"
Debug.Print a.class2Arr(0).str1
And I have an error because get property on class2Arr have no arguments
You just declared array, but not initialized it Private pClass2Arr(10) as Class2. I've added Private Sub Class_Initialize() event in Class1:
Private pClass2Arr(10) As Class2
Public Property Get class2Arr() As Class2()
class2Arr = pClass2Arr
End Property
Public Property Let class2Arr(mClass2Arr() As Class2)
pClass2Arr = mClass2Arr
End Property
Private Sub Class_Initialize()
Dim i As Byte ' change Byte to Integer if your array contains more than 255 elements
For i = LBound(pClass2Arr) To UBound(pClass2Arr)
Set pClass2Arr(i) = New Class2
Next
End Sub
and then you can use it like this:
Sub test()
Dim a As Class1
Set a = New Class1
a.class2Arr()(0).str1 = "test"
Debug.Print a.class2Arr()(0).str1
End Sub