I have several classes containing details about an onsite switchboard. I am using a Userform to store data in the variables declared in each class. I am struggling to store the data in any of my arrays. Am I going the right way about declaring these variables? Here's an example of one of my classes:
Dim pEquipID(3) As String
Dim pIr(3) As Integer
Dim pIm(3) As Integer
Dim pTripCurrent(3) As Integer
Dim pTripTime(3) As Integer
Dim pIsc(3) As Integer
Public Property Let EquipID(index As Integer, value As String)
pEquipID(index) = value
End Property
Public Property Let Ir(index As Integer, value As Integer)
pIr(index) = value
End Property
Public Property Let Im(index As Integer, value As Integer)
pIm(index) = value
End Property
Public Property Let TripCurrent(index As Integer, value As Integer)
pTripCurrent(index) = value
End Property
Public Property Let TripTime(index As Integer, value As Integer)
pTripTime(index) = value
End Property
Public Property Let Isc(index As Integer, value As Integer)
pIsc(index) = value
End Property
Public Property Get EquipID(index As Integer) As String
EquipID(index) = pEquipID(index)
End Property
Public Property Get Ir(index As Integer) As Integer
Ir(index) = pIr(index)
End Property
Public Property Get Im(index As Integer) As Integer
Im(index) = pIm(index)
End Property
Public Property Get TripCurrent(index As Integer) As Integer
TripCurrent(index) = pTripCurrent(index)
End Property
Public Property Get TripTime(index As Integer) As Integer
TripTime(index) = pTripTime(index)
End Property
Public Property Get Isc(index As Integer) As Integer
Isc(index) = pIsc(index)
End Property
And this is how I am storing the data:
Private Sub Enter1_Click()
'create class variables
Dim Transformer1 As cTransformer
Set Transformer1 = New cTransformer
Dim Fuse1 As cFuse
Set Fuse1 = New cFuse
Dim CircuitBreaker1 As cCircuitBreaker
Set CircuitBreaker1 = New cCircuitBreaker
Dim Pump1 As cPump
Set Pump1 = New cPump
Dim Cable1 As cCable
Set Cable1 = New cCable
'store circuit breaker entries
CircuitBreaker1.EquipID(0) = CB1ID1.value
CircuitBreaker1.EquipID(1) = CB2ID1.value
CircuitBreaker1.Ir(0) = Cb1Ir1.value
CircuitBreaker1.Ir(1) = CB2Ir1.value
CircuitBreaker1.Im(0) = CB1Im1.value
CircuitBreaker1.Im(1) = CB2Im1.value
CircuitBreaker1.Isc(0) = CB1Isc1.value
CircuitBreaker1.Isc(1) = CB2Isc1.value
CircuitBreaker1.TripCurrent(0) = CB1trip1.value
CircuitBreaker1.TripCurrent(1) = CB2trip1.value
CircuitBreaker1.TripTime(0) = CB1time1.value
CircuitBreaker1.TripTime(1) = CB2time1.value
When I debug.print the CircuitBreaker array the terminal prints blank values. I use a loop like this to print each array:
Dim count As integer
For count = 0 To 1 Step 1
Debug.Print CircuitBreaker1.EquipID(count)
Next count
Note that this print statement is inside Enter1_click()
Your Property Get is incorrect. Instead of:
Public Property Get EquipID(index As Integer) As String
EquipID(index) = pEquipID(index)
End Property
... it should be:
Public Property Get EquipID(index As Integer) As String
EquipID = pEquipID(index)
End Property
Related
I would like to set a Get property for a class in vba to be an array. How do I do this.
in the class module
Dim pdbCGX As Double
Dim pdbCGY As Double
Dim pdbCGZ As Double
Public Property Get TheCGv() As Double
TheCGv(0) = pdbCGX
TheCGv(1) = pdbCGY
TheCGv(2) = pdbCGZ
End Property
'allocation of data in a sub in the class
pdbCGX = CDbl(extracteddata1)
pdbCGY = CDbl(extracteddata2)
pdbCGZ = CDbl(extracteddata3)
I would suggest to do it like that
Option Explicit
Dim pdbCGX As Double
Dim pdbCGY As Double
Dim pdbCGZ As Double
Public Property Get TheCGv() As Variant
Dim v(0 To 2) As Double
v(0) = pdbCGX
v(1) = pdbCGY
v(2) = pdbCGZ
TheCGv = v
End Property
If you want to return an array with data type double your code could look like that
Option Explicit
Dim pdbCGX As Double
Dim pdbCGY As Double
Dim pdbCGZ As Double
Public Property Get TheCGv() As Double()
Dim v(0 To 2) As Double
v(0) = pdbCGX
v(1) = pdbCGY
v(2) = pdbCGZ
TheCGv = v
End Property
A better solution to this problem is to not use an array, but instead put a scripting.Dictionary inside the class and also set up an enumeration to ensure that reading and writing to the scripting .Dictionary is strongly typed.
The code below is a wrapper class for a Scripting.dictionary to which I've added an Enum based on your post above.
Option Explicit
' Strongly typed wrapper for the Scripting.Dictionary
' Replace KeyType with the Type for the Key to be used -> done using pdb
' Replace ValueType with the Type for the Values to be used - done using Double
Public Enum pdb
CGX
CGY
CGZ
End Enum
Private Type State
Host As Scripting.Dictionary
End Type
Private s As State
Private Sub Class_Initialize()
'Set s.Host = CreateObject("Scripting.Dictionary")
Set s.Host = New Scripting.Dictionary
End Sub
'#Description("Add: Adds a new key/item pair to a Dictionary object").
Public Sub Add(ByVal Key As pdb, ByVal Value As Double)
s.Host.Add Key, Value
End Sub
'#Description("Count: Returns the number of key/item pairs in a Dictionary object.")
Public Function Count() As Long
Count = s.Host.Count
End Function
'#Description("CompareMode: Sets or returns the comparison mode for comparing keys in a Dictionary object.")
Public Property Get CompareMode() As Scripting.CompareMethod
CompareMode = s.Host.CompareMode
End Property
Public Property Let CompareMode(ByVal Compare As Scripting.CompareMethod)
s.Host.CompareMode = Compare
End Property
'#Description("Exists Returns a Boolean value that indicates whether a specified key exists in the Dictionary object.)
Public Function Exists(ByVal Key As pdb) As Boolean
Exists = s.Host.Exists(Key)
End Function
'#Description("Item: Get or returns the value of an item in a Dictionary object.")
'#DefaultMember
Public Property Get Item(ByVal Key As pdb)
Item = s.Host(Key)
End Property
' Delete Let or Set depending if Value is a primitive or object type
Public Property Let Item(ByVal Key As pdb, ByVal Value As Double)
s.Host(Key) = Value
End Property
Public Property Set Item(ByVal Key As pdb, ByVal Value As Double)
Set s.Host(Key) = Value
End Property
'#Description("'Items: Returns an array of all the items in a Dictionary object.")
Public Function Items() As Variant
Items = s.Host.Items
End Function
'#Description("Key Sets a new key value for an existing key value in a Dictionary object.")
Public Sub Key(ByVal OldKey As pdb, ByVal NewKey As pdb)
s.Host.Key(OldKey) = NewKey
End Sub
'#Description("Keys Returns an array of all the keys in a Dictionary object.")
Public Function Keys() As Variant
Keys = s.Host.Keys()
End Function
'#Description("Remove Removes one specified key/item pair from the Dictionary object.")
Public Sub Remove(ByVal Key As pdb)
s.Host.Remove (Key)
End Sub
'#Description("RemoveAll: Removes all the key/item pairs in the Dictionary object.")
Public Sub RemoveAll()
s.Host.RemoveAll
End Sub
If you do require an array, for example you are putting values back into Excel, then the values in the scripting dictionary can be obtained as an Array from the .Items method.
I'm trying to set a property of an object which is part of a class object array, for excel in VBA.
The code looks like this:
Dim myClass(5) as class1
Dim i as integer
For i = 0 to 5
set myClass(i) = New class
myClass(i).myProperty = "SomeValue"
Next i
Class code is simply:
Private pmyProperty as string
Public Property Let myProperty(s as string)
pmyProperty = s
End Property
Public Property Get myProperty() as string
myProperty = pmyProperty
End Property
However when I run this, I get a compile error "expected: list separator." This hits on the myClass(i).myProperty = "SomeValue" line.
How do I set the value of a property of an class object that is part of an array?
Any help would be great!
So the actual code is as follows...
Module code:
Public Sub main_sb_BillingApp()
Dim intCountComplete As Integer
Dim intLastRow As Integer
Dim Line() As clsLine
Dim i As Integer, x As Integer
intCountComplete = WorksheetFunction.CountIf(Sheets(WS_NAME).Columns(COL_W_COMPLETE), "Yes")
intLastRow = Sheets(WS_NAME).Cells(LAST_ROW, COL_W_COMPLETE).End(xlUp).Row - 1
ReDim Line(intCountComplete - 1)
For i = ROW_W_HEADER + 1 To intLastRow
If Sheets(WS_NAME).Cells(i, COL_W_COMPLETE) = "Yes" Then
Set Line(x) = New clsLine
Line(x).Row = i
x = x + 1
End If
Next i
End Sub
Class code:
Private pDate As Date
Private pUJN As String
Private pDesc As String
Private pCharge As Currency
Private pCost As Currency
Private pMargin As Double
Private pComplete As Boolean
Private pRow As Integer
Public Property Let Row(i As Integer)
pRow = i
Update
End Property
Public Property Get Row() As Integer
Row = pRow
End Property
Private Sub Update()
With Sheets(WS_NAME)
pDate = .Cells(pRow, COL_W_DATE)
pUJN = .Cells(pRow, COL_W_UJN)
pDesc = .Cells(pRow, COL_W_DESC)
pCharge = .Cells(pRow, COL_W_CHARGE)
pCost = .Cells(pRow, COL_W_COST)
pMargin = .Cells(pRow, COL_W_MARGIN)
If .Cells(pRow, COL_W_COMPLETE) = "Yes" Then
pComplete = True
Else
pComplete = False
End If
End With
End Sub
Line is a VBA reserved keyword, so you're confusing the compiler. Change the name of your object array and it works just fine:
Dim lineArray() As clsLine
'...
Set lineArray(x) = New clsLine
lineArray(x).Row = i
I am trying to make a bit of a leap in coding from just using dictionaries (which I only understand in a basic way) to using a Class object to hold data.
I have created a Class purely to hold 4 items of data which need to be held together and then referenced later. I then have code that creates a couple of these Class objects and which populate data into their 4 bits.
Here is my Class Module (called NarrativeGroup) :
Private pNarrative As String
Private pBillCat As String
Private pDateIndex As String
Private pFrequency As Long
''''''''''''''''''''''
' Narrative properties
''''''''''''''''''''''
Public Property Get Narrative() As String
Narrative = pNarrative
End Property
Public Property Let Narrative(Value As String)
pNarrative = Value
End Property
''''''''''''''''''''''
' BillCat properties
''''''''''''''''''''''
Public Property Get BillCat() As String
BillCat = pBillCat
End Property
Public Property Let BillCat(Value As String)
pBillCat = Value
End Property
''''''''''''''''''''''
' DateIndex properties
''''''''''''''''''''''
Public Property Get DateIndex() As String
DateIndex = pDateIndex
End Property
Public Property Let DateIndex(Value As String)
pDateIndex = Value
End Property
''''''''''''''''''''''
' Frequency properties
''''''''''''''''''''''
Public Property Get Frequency() As String
Frequency = pFrequency
End Property
Public Property Let Frequency(Value As String)
pFrequency = Value
End Property
I then have the following code in a normal module. I am trying to load the 4 item types into an array and then to try and test if it is working. My reason for loading it into an array is to then use a sub to output it onto a worksheet. But the code errors! :
Sub setNarrativeGroup() 'to put the dictionary of Narrative object Items into an array
Set dict_Narratives = New Scripting.Dictionary
dict_Narratives.CompareMode = TextCompare 'make text comparisons so they are not case sensitive
Dim NewNarrative As NarrativeGroup
Set NewNarrative = New NarrativeGroup
Dim array_Narratives As Variant
NewNarrative.Narrative = "fee prep"
NewNarrative.BillCat = "Billing"
NewNarrative.DateIndex = "01.2015"
NewNarrative.Frequency = 3
dict_Narratives.Add NewNarrative.Narrative, NewNarrative
NewNarrative.Narrative = "meeting"
NewNarrative.BillCat = "Trustee Meeting"
NewNarrative.DateIndex = "02.2015"
NewNarrative.Frequency = 1
dict_Narratives.Add NewNarrative.Narrative, NewNarrative
array_Narratives = dict_Narratives.Items
MsgBox array_Narratives(1, 1)
Call PrintArray(array_Narratives, "Sheet1", 1, 1)
End Sub
Sub PrintArray(Data, SheetName As String, intStartRow As Integer, intStartCol As Integer)
Dim oWorksheet As Worksheet
Dim rngCopyTo As Range
Set oWorksheet = ActiveWorkbook.Worksheets(SheetName)
' size of array
Dim intEndRow As Integer
Dim intEndCol As Integer
intEndRow = UBound(Data, 1)
intEndCol = UBound(Data, 2)
Set rngCopyTo = oWorksheet.Range(oWorksheet.Cells(intStartRow, intStartCol), oWorksheet.Cells(intEndRow, intEndCol))
rngCopyTo.Value = Data
End Sub
I have tried to search for help on working with dictionaries of class objects and spitting them out into an array, but there doesn't seem to be much out there! Any help much appreciated, and apologies for any big no-no's in my code above! :)
I'm designing a dynamic buffer for outgoing messages. The data structure takes the form of a queue of nodes that have a Byte Array buffer as a member. Unfortunately in VBA, Arrays cannot be public members of a class.
For example, this is a no-no and will not compile:
'clsTest
Public Buffer() As Byte
You will get the following error: "Constants, fixed-length strings, arrays, user-defined types and Declare statements not allowed as Public members of object modules"
Well, that's fine, I'll just make it a private member with public Property accessors...
'clsTest
Private m_Buffer() As Byte
Public Property Let Buffer(buf() As Byte)
m_Buffer = buf
End Property
Public Property Get Buffer() As Byte()
Buffer = m_Buffer
End Property
...and then a few tests in a module to make sure it works:
'mdlMain
Public Sub Main()
Dim buf() As Byte
ReDim buf(0 To 4)
buf(0) = 1
buf(1) = 2
buf(2) = 3
buf(3) = 4
Dim oBuffer As clsTest
Set oBuffer = New clsTest
'Test #1, the assignment
oBuffer.Buffer = buf 'Success!
'Test #2, get the value of an index in the array
' Debug.Print oBuffer.Buffer(2) 'Fail
Debug.Print oBuffer.Buffer()(2) 'Success! This is from GSerg's comment
'Test #3, change the value of an index in the array and verify that it is actually modified
oBuffer.Buffer()(2) = 27
Debug.Print oBuffer.Buffer()(2) 'Fail, diplays "3" in the immediate window
End Sub
Test #1 works fine, but Test #2 breaks, Buffer is highlighted, and the error message is "Wrong number of arguments or invalid property assignment"
Test #2 now works! GSerg points out that in order to call the Property Get Buffer() correctly and also refer to a specific index in the buffer, TWO sets of parenthesis are necessary: oBuffer.Buffer()(2)
Test #3 fails - the original value of 3 is printed to the Immediate window. GSerg pointed out in his comment that the Public Property Get Buffer() only returns a copy and not the actual class member array, so modifications are lost.
How can this third issue be resolved make the class member array work as expected?
(I should clarify that the general question is "VBA doesn't allow arrays to be public members of classes. How can I get around this to have an array member of a class that behaves as if it was for all practical purposes including: #1 assigning the array, #2 getting values from the array, #3 assigning values in the array and #4 using the array directly in a call to CopyMemory (#3 and #4 are nearly equivalent)?)"
So it turns out I needed a little help from OleAut32.dll, specifically the 'VariantCopy' function. This function faithfully makes an exact copy of one Variant to another, including when it is ByRef!
'clsTest
Private Declare Sub VariantCopy Lib "OleAut32" (pvarDest As Any, pvargSrc As Any)
Private m_Buffer() As Byte
Public Property Let Buffer(buf As Variant)
m_Buffer = buf
End Property
Public Property Get Buffer() As Variant
Buffer = GetByRefVariant(m_Buffer)
End Property
Private Function GetByRefVariant(ByRef var As Variant) As Variant
VariantCopy GetByRefVariant, var
End Function
With this new definition, all the tests pass!
'mdlMain
Public Sub Main()
Dim buf() As Byte
ReDim buf(0 To 4)
buf(0) = 1
buf(1) = 2
buf(2) = 3
buf(3) = 4
Dim oBuffer As clsTest
Set oBuffer = New clsTest
'Test #1, the assignment
oBuffer.Buffer = buf 'Success!
'Test #2, get the value of an index in the array
Debug.Print oBuffer.Buffer()(2) 'Success! This is from GSerg's comment on the question
'Test #3, change the value of an index in the array and verify that it is actually modified
oBuffer.Buffer()(2) = 27
Debug.Print oBuffer.Buffer()(2) 'Success! Diplays "27" in the immediate window
End Sub
#Blackhawk,
I know it is an old post, but thought I'd post it anyway.
Below is a code I used to add an array of points to a class, I used a subclass to define the individual points, it sounds your challenge is similar:
Mainclass tCurve
Private pMaxAmplitude As Double
Private pCurvePoints() As cCurvePoint
Public cDay As Date
Public MaxGrad As Double
Public GradChange As New intCollection
Public TideMax As New intCollection
Public TideMin As New intCollection
Public TideAmplitude As New intCollection
Public TideLow As New intCollection
Public TideHigh As New intCollection
Private Sub Class_Initialize()
ReDim pCurvePoints(1 To 1500)
ReDim curvePoints(1 To 1500) As cCurvePoint
Dim i As Integer
For i = 1 To 1500
Set Me.curvePoint(i) = New cCurvePoint
Next
End Sub
Public Property Get curvePoint(Index As Integer) As cCurvePoint
Set curvePoint = pCurvePoints(Index)
End Property
Public Property Set curvePoint(Index As Integer, Value As cCurvePoint)
Set pCurvePoints(Index) = Value
End Property
subclass cCurvePoint
Option Explicit
Private pSlope As Double
Private pCurvature As Double
Private pY As Variant
Private pdY As Double
Private pRadius As Double
Private pArcLen As Double
Private pChordLen As Double
Public Property Let Slope(Value As Double)
pSlope = Value
End Property
Public Property Get Slope() As Double
Slope = pSlope
End Property
Public Property Let Curvature(Value As Double)
pCurvature = Value
End Property
Public Property Get Curvature() As Double
Curvature = pCurvature
End Property
Public Property Let valY(Value As Double)
pY = Value
End Property
Public Property Get valY() As Double
valY = pY
End Property
Public Property Let Radius(Value As Double)
pRadius = Value
End Property
Public Property Get Radius() As Double
Radius = pRadius
End Property
Public Property Let ArcLen(Value As Double)
pArcLen = Value
End Property
Public Property Get ArcLen() As Double
ArcLen = pArcLen
End Property
Public Property Let ChordLen(Value As Double)
pChordLen = Value
End Property
Public Property Get ChordLen() As Double
ChordLen = pChordLen
End Property
Public Property Let dY(Value As Double)
pdY = Value
End Property
Public Property Get dY() As Double
dY = pdY
End Property
This will create a tCurve with 1500 tCurve.Curvepoints().dY (for example)
The trick is to get the index process correct in the main class !
Good luck !
Not the most elegant solution, but modeling from the code you provided...
In clsTest:
Option Explicit
Dim ArrayStore() As Byte
Public Sub AssignArray(vInput As Variant, Optional lItemNum As Long = -1)
If Not lItemNum = -1 Then
ArrayStore(lItemNum) = vInput
Else
ArrayStore() = vInput
End If
End Sub
Public Function GetArrayValue(lItemNum As Long) As Byte
GetArrayValue = ArrayStore(lItemNum)
End Function
Public Function GetWholeArray() As Byte()
ReDim GetWholeArray(LBound(ArrayStore) To UBound(ArrayStore))
GetWholeArray = ArrayStore
End Function
And in mdlMain:
Sub test()
Dim buf() As Byte
Dim bufnew() As Byte
Dim oBuffer As New clsTest
ReDim buf(0 To 4)
buf(0) = 1
buf(1) = 2
buf(2) = 3
buf(3) = 4
oBuffer.AssignArray vInput:=buf
Debug.Print oBuffer.GetArrayValue(lItemNum:=2)
oBuffer.AssignArray vInput:=27, lItemNum:=2
Debug.Print oBuffer.GetArrayValue(lItemNum:=2)
bufnew() = oBuffer.GetWholeArray
Debug.Print bufnew(0)
Debug.Print bufnew(1)
Debug.Print bufnew(2)
Debug.Print bufnew(3)
End Sub
I added code to pass the class array to another array to prove accessibility.
Even though VBA won't allow us to pass arrays as properties, we can still use Functions to pick up where properties fall short.
I have a class where one of the member variables is an array. I am trying to assign an array to the object but keep getting the 'Can't assign array' compile error. Also I was curious as how to get UBound of the array in object. UBound(obj.array) doesn't compile. I am using excel 07 vba.
'Test routine that keeps failing
Sub test()
Dim Arr(2) As String
Arr(0) = ""
Arr(1) = "Pizza"
Arr(2) = "Hoes"
Dim obj As Cats
Set obj = New Cats
obj.avry = Arr
obj.field = 4
MsgBox UBound(obj.ary)
End Sub
'Class declaration
Private pary() As String
Private pfield As Long
Public Property Get ary(ByVal index As Long) As String
Set ary = pary(index)
End Property
Public Property Let avry(Value() As String)
ReDim pary(UBound(Value)) As String
For i = LBound(Value) To UBound(Value)
pary(i) = Value(i)
Next i
End Property
Public Property Get field() As Long
field = pfield
End Property
Public Property Let field(Value As Long)
pfield = Value
End Property
Private Sub Class_Initialize()
pfield = 0
End Sub
This worked for me
Sub test()
Dim Arr(2) As String
Arr(0) = ""
Arr(1) = "Pizza"
Arr(2) = "Hoes"
Dim obj As Cats
Set obj = New Cats
obj.avry = Arr
obj.field = 4
MsgBox obj.ary(2)
End Sub
Public Property Get ary(ByVal index As Long) As String
ary = pary(index)
End Property
Public Property Let avry(vValue As Variant)
ReDim pary(UBound(vValue)) As String
Dim i As Long
For i = LBound(vValue) To UBound(vValue)
pary(i) = vValue(i)
Next i
End Property
Public Property Get field() As Long
field = pfield
End Property
Public Property Let field(Value As Long)
pfield = Value
End Property
Private Sub Class_Initialize()
pfield = 0
End Sub
As Tim said, you can pass the array as a variant. Your MsgBox is trying to find a UBound of a String data type, so that was a problem. Also, you weren't passing an argument to ary in the MsgBox. The ary property returns a String, but you were using the Set keyword, which was another problem.
There seems to be an issue with passing array parameters to class properties.
You can get around this by switching the Let parameter to a Variant:
Public Property Let avry(ByRef arrVal As Variant)
Dim i As Integer
If IsArray(arrVal) Then
ReDim pary(LBound(arrVal) To UBound(arrVal))
For i = LBound(arrVal) To UBound(arrVal)
pary(i) = arrVal(i)
Next i
End If
End Property