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
Related
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
Recently learned a bit of object oriented in Python, and I'm trying to do the same things in VBA.
I manage to construct a parent object (PC) that contains a dictionary of children objects:hooks. Hooks is also an object with a dictionary of children: rows.
All I want to do it to be able to write:
for each hook in PC
for each row in hook
sheets("X").cells(i,1) = contract.price
next row
next hook
Im looking at this but can't make it work...
Here summary of classes:
Class PC
Option Explicit
Public pPC As Object
Private pName As String
Private pInclude As Boolean
Private Sub Class_Initialize()
Set pPC = CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
Set pPC = Nothing
End Sub
Public Property Get hook(HookName As String) As CHook:
Set hook = pPC(HookName)
End Property
Public Sub Add(hook As CHook):
If Not pPC.exists(hook.Name) Then pPC.Add hook.Name, hook
End Sub
Public Property Get Include(HookName As String) As Boolean:
pInclude = pPC.exists(HookName)
Include = pInclude
End Property
Public Property Let Name(pcname As String):
pName = pcname
End Property
Public Property Get Name() As String:
Name = pName
End Property
Class Hook
Option Explicit
Public pHook As Object
Private pName As String
Private pLTFlatPrice As Double
Private pLTBasisPrice As Double
Private pLTDate As Date
Private Sub Class_Initialize()
Set pHook = CreateObject("Scripting.Dictionary")
pLTDate = Sheets("Control").Cells(2, 2)
End Sub
Private Sub Class_Terminate()
Set pHook = Nothing
End Sub
Public Sub AddRow(Row As CRow)
If Not pHook.exists(Row.ContractLot) Then pHook.Add Row.ContractLot, Row
If Row.TradeDate < pLTDate Then
pLTDate = Row.TradeDate
If IsNumeric(Row.FlatMV) And Row.FlatMV <> 0 Then pLTFlatPrice = Row.FlatMV
If IsNumeric(Row.BasisMV) Then pLTBasisPrice = Row.BasisMV
End If
End Sub
Public Property Get Row(ContractLot As String) As CRow:
Set Row = pHook.Item(ContractLot)
End Property
Public Property Let Name(HookName As String):
pName = HookName
End Property
Public Property Get Name() As String:
Name = pName
End Property
Public Property Get LTFlatPrice() As Double:
LTFlatPrice = pLTFlatPrice
End Property
Public Property Get LTBasisPrice() As Double:
LTBasisPrice = pLTBasisPrice
End Property
Public Property Get LTDate() As Double:
LTDate = pLTDate
End Property
and here is the peace of code where the error happens (Object doesn't support this property or method):
For i = 2 To UBound(path, 1)
tName = path(i, 1)
Next i
Set PC = SArray.PC(tName)
For Each hook In PC
For Each row In hook
With Sheets("COB")
.Cells(ii, 2) = row.PC
.Cells(ii, 3) = row.hook
.Cells(ii, 4) = row.Period
End With
ii = ii + 1
Next row
Next hook
You can iterate over either the keys or the items of a dictionary:
Sub Tester()
Dim d As New Scripting.Dictionary
Dim k
d.Add "one", 1
d.Add "two", 2
d.Add "three", 3
For Each k In d.Keys
Debug.Print k
Next
For Each k In d.Items
Debug.Print k
Next
End Sub
So, you can expose your dictionary as a property of an object and iterate over that. It does mean you need to specify .Items though (since it will default to keys.
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
New to building class modules in VBA and struggling with populating one object which is defined within another object.
For instance, I have two class modules, Class1 and Class2
Class1
Dim mobj As Class2
Public Property Set SetObj(obj As Class2)
Set mobj = obj
End Property
Class2
Public FirstName As String
These are accessed from a standard module as follows:
Sub test()
Dim X As Class1
Set X = New Class1
Set X.SetObj = New Class2
X.SetObj.FirstName = "Bruce"
End Sub
This however fails in X.SetObj.FirstName = "Bruce" when i get an "Invalid use of property message". Any assistance would be greatly appreciated.
You are close.
Class1:
Private mobj As Class2
Public Property Set Obj(Obj As Class2)
Set mobj = Obj
End Property
Public Property Get Obj()
Set Obj = mobj
End Property
Sub (the X.Obj.FirstName line calls the Get property, not the Set property):
Sub test()
Dim X As Class1
Set X = New Class1
Set X.Obj = New Class2
X.Obj.FirstName = "Bruce"
End Sub