I have two classes:
clsDataElement
Public dataA As String
Public dataB As String
Public dataC As String
clsInterface
Private mDataElements() As clsDataElement
Private mCountOfDataElements As Integer
Private Sub Class_Initialize()
mCountOfDataElements = 0
End Sub
Public Sub addDataElement(dataElement As clsDataElement)
ReDim Preserve mDataElements(mCountOfDataElements)
Set mDataElements(mCountOfDataElements) = New clsDataElement
mDataElements(mCountOfDataElements).dataA = dataElement.dataA
mDataElements(mCountOfDataElements).dataB = dataElement.dataB
mDataElements(mCountOfDataElements).dataC = dataElement.dataC
mCountOfDataElements = mCountOfDataElements + 1
End Sub
Public Function getDataElement(Optional index As Integer) As clsDataElement
If Not index >= mCountOfDataElements Then
getDataElement = mDataElements(index)
End If
End Function
So as you can see, the class clsDataElement is just a containe for some data.
The class clsInterface can contain multiple Elements of clsDataElement
Now if I want to read one Data Element from the interface class, it just does not work. However, I feel like this is related to the fact, that I cannot just assign custom classes:
Public Sub TestMyClass(myInterface As clsInterface)
Dim tmpDataElement As New clsDataElement
Set tmpDataElement = myInterface.getDataElement(0)
End Sub
So when running this code I get the error
Object variable or with block variable not set
I made sure that there are multiple data elements stored in myInterface.
Do you have any ideas what I am doing wrong?
Aren't you missing the 'Set' keyword when getting the element:
Public Function getDataElement(Optional index As Integer) As clsDataElement
If Not index >= mCountOfDataElements Then
Set getDataElement = mDataElements(index)
End If
End Function
Related
While this code works and I can assign and retrieve values across all levels, intellisense only displays the methods or properties 1 level deep. How would I go about coding this so that I can follow my "Path" all the way down using intellisense and not necessarily have to just remember the methods or properties?
for instance if I type Wip. I get
but when I type Wip.Parts("Test"). , the SequenceNumbers member and its Methods/Properties are not displayed
I have the following code
clsSeq:
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
clsPart:
Option Explicit
Private iPart As String
Public SequenceNumbers As Collection
Public Property Get PartNumber() As String
PartNumber = iPart
End Property
Public Property Let PartNumber(lPart As String)
iPart = lPart
End Property
Public Sub AddSequence(aSeq As String, aQty As Double)
Dim iSeq As clsSeq
If SeqExists(aSeq) Then
Set iSeq = SequenceNumbers.Item(aSeq)
iSeq.Qty = iSeq.Qty + aQty
Else
Set iSeq = New clsSeq
With iSeq
.Sequence = aSeq
.Qty = aQty
End With
SequenceNumbers.Add iSeq, iSeq.Sequence
End If
Set iSeq = Nothing
End Sub
Private Sub Class_Initialize()
Set SequenceNumbers = New Collection
End Sub
Private Function SeqExists(iSeq As String) As Boolean
Dim v As Variant
On Error Resume Next
v = IsObject(SequenceNumbers.Item(iSeq))
SeqExists = Not IsEmpty(v)
End Function
clsParts:
Option Explicit
Public Parts As Collection
Public Sub AddPart(iPart As String)
Dim iPrt As clsPart
If Not PartExists(iPart) Then
Set iPrt = New clsPart
With iPrt
.PartNumber = iPart
End With
Parts.Add iPrt, iPrt.PartNumber
End If
End Sub
Private Function PartExists(iPT As String) As Boolean
Dim v As Variant
On Error Resume Next
v = IsObject(Parts.Item(iPT))
PartExists = Not IsEmpty(v)
End Function
Private Sub Class_Initialize()
Set Parts = New Collection
End Sub
modTest:
Sub TestWipCls()
Dim Wip As clsParts
Dim Part As clsPart
Set Wip = New clsParts
Wip.AddPart ("Test")
Set Part = Wip.Parts("Test")
Part.AddSequence "Proc7", 1505
Debug.Print Wip.Parts("Test").SequenceNumbers("Proc7").Qty
Part.AddSequence "Proc7", 100
Debug.Print Wip.Parts("Test").SequenceNumbers("Proc7").Qty
End Sub
That is because Parts is a Collection and its Default Member Call (or .Item) will return a value/object depending what was stored. While editing your code VBA does not know what kind of value/object is stored in the collection (as this is only established during run-time, eg. late-bound), so it can not give you any Intellisense-suggestions.
To circumvent this, you need a method (property/function) that returns a defined type of value/object (early-bound).
btw. (myCollection.("Foo") is the same as myCollection.Item("Foo"))
The solution is to create a custom collection that returns a value of a defined type.
The following example also explains how to implement a custom Collection so you can use the default member call instead of using .Item.
How to use the Implements in Excel VBA
While we're at it, please never use public variables in classes, make them accessible via Property Let/Set/Get methods!
More on this here: https://rubberduckvba.wordpress.com/2019/07/08/about-class-modules/
Edit:
Example for a custom Collection for classes that implement ICustomElement (Interfaces are explained in the link above)
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "CustomCollectionTemplate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'#Folder("Classes")
Option Explicit
Private Type TCustomCollection
CustomCollection as Collection
End Type
Dim this as TCustomCollection
Private Sub Class_Initialize()
Set this.CustomCollection = New Collection
End Sub
Private Sub Class_Terminate()
Set this.CustomCollection = Nothing
End Sub
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
Set NewEnum = this.CustomCollection.[_NewEnum]
End Property
Public Sub Add(ByVal newCustomElement As ICustomElement)
this.CustomCollection.Add newCustomElement
End Sub
Public Sub Remove(ByVal Index As Long)
this.CustomCollection.Remove Index
End Sub
Public Function Item(ByVal Index As Long) As ICustomElement
Set Item = this.CustomCollection.Item(Index)
End Function
Public Function Count() As Long
Count = this.CustomCollection.Count
End Function
Thanks to M.Doerner & Mathieu Guindeon for the edits/comments
I have two Class and I want to save my data into arrays form text box like this:
Students.Name(txtID.Text-1).MathMark = txtMark.Text
but I get error: Object reference not set to an instance of an object
my code is:
Dim StudentsNumber as Integer = txtstdnum.Text
Dim Students as New StudentsInf(StudentsNumber)
Students.Name(txtID.Text-1).MathMark = txtMark.Text
Public Class StudentsInf
Private mName() As String
Sub New(ByVal StudentNumbers As Integer)
ReDim mName(StudentNumbers-1)
End Sub
Public Property Name(ByVal Index As Integer) As LessonsMark
Get
Return mName(Index)
End Get
Set(ByVal Value As LessonsMark)
mName(Index) = Value
End Set
End Property
End Class
Public Class LessonsMark
Private mMathMark() As Object
Public Property MathMark() As Object
Get
Return mMathMark
End Get
Set(ByVal Value As Object)
mMathMark = Value
End Set
End Property
End Class
This:
Private mName() As String
needs to be:
Private mName() As LessonsMark
then you have to create the objects in your constructor, something like:
Sub New(ByVal StudentNumbers As Integer)
ReDim mName(StudentNumbers - 1)
For i As Integer = 0 To StudentNumbers - 1
mName(i) = New LessonsMark()
Next
End Sub
then it looks like your LessonsMark class is declaring an array of objects when it looks like it should be just a string property:
Public Class LessonsMark
Private mMathMark As String
Public Property MathMark As String
Get
Return mMathMark
End Get
Set(ByVal Value As String)
mMathMark = Value
End Set
End Property
End Class
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 am using ArcGIS. I am trying to sort the data manually after its found. I created a property class and loop through a Tlist to scrub unwanted data. However right before it binds to the data grid, I receive a cast error. I assume something is coming back null. Am I missing something??
Public Class temp
Public Sub New()
End Sub
Public Property DisplayFieldName As String
Public Property Feature As ESRI.ArcGIS.Client.Graphic
Public Property FoundFieldName As String
Public Property LayerId As Integer
Public Property LayerName As String
Public Property Value As Object
End Class
Public Class templst
Public Sub New()
Dim findresult = New List(Of temp)
End Sub
Private _findresult = findresult
Public Property findresult() As List(Of temp)
Get
Return _findresult
End Get
Set(ByVal value As List(Of temp))
_findresult = value
End Set
End Property
End Class
Private Sub FindTask_Complete(ByVal sender As Object, ByVal args As FindEventArgs)
Dim newargs As New templst() 'puts Tlist (temp) into property
Dim templistNUMONLY As New List(Of temp) 'Tlist of temp
For Each r In args.FindResults 'class in compiled dll.
If Regex.Match(r.Value.ToString, "[0-9]").Success Then
templistNUMONLY.Add(New temp() With {.LayerId = r.LayerId,
.LayerName = r.LayerName,
.Value = r.Value,
.FoundFieldName = r.FoundFieldName,
.DisplayFieldName = r.DisplayFieldName,
.Feature = r.Feature})
End If
Next
newargs.findresult = templistNUMONLY
Dim sortableView As New PagedCollectionView(newargs.findresult)
FindDetailsDataGrid.ItemsSource = sortableView 'populate lists here
End Sub
BIND TO GRID HERE: (Error here)
Private Sub FindDetails_SelectionChanged(ByVal sender As Object, ByVal e As SelectionChangedEventArgs)
' Highlight the graphic feature associated with the selected row
Dim dataGrid As DataGrid = TryCast(sender, DataGrid)
Dim selectedIndex As Integer = dataGrid.SelectedIndex
If selectedIndex > -1 Then
'''''''''''''''''CAST ERROR HERE:
Dim findResult As FindResult = CType(FindDetailsDataGrid.SelectedItem, FindResult)
You populate FindDetailsDataGrid with objects of type temp, but you try to cast it to type FindResult instead. You should do:
Dim selectedTemp As temp = CType(FindDetailsDataGrid.SelectedItem, temp)
'*Create find result from selected temp object here*
I’m working on some partial classes but I can’t figure out how to do it.
This is my classes:
Partial Public Class Form
Private InfoField() As Info
Private FormgroupField() As FormGroup
Private tittle As String
Public Property Info() As Info()
Get
Return Me. InfoField
End Get
Set
Me. InfoField = value
End Set
End Property
Public Property FormGroup() As FormGroup()
Get
Return Me.GromGroupField
End Get
Set
Me.FormGroupField = value
End Set
End Property
Public Property tittle() As String
Get
Return Me.tittleField
End Get
Set
Me.tittleField = value
End Set
End Property
End class
Partial Public Class Info
Private ChangeFormField() As ChangeForm
Private formYearField() As FormYea
Private idField As String
Public Property ChangeForm() As ChangeForm()
Get
Return Me.changeFormField
End Get
Set
Me.changeFormField = value
End Set
End Property
Public Property FormYear() As FormYear()
Get
Return Me.formYearField
End Get
Set
Me.formYearField = value
End Set
End Property
Public Property id() As String
Get
Return Me.idField
End Get
Set
Me.idField = value
End Set
End Property
End Class
Partial Public Class ChangeForm
Private idField As String
Private valueField As String
<properties goes here>
End Class
Partial Public Class FormYear
Private idField As String
Private valueField As String
<properties goes here>
End Class
And for the class FormGroup the organization is the same.
I want to build partial classes to extend these classes, so when I use all this classes in another project I only have to deal with (see) the topmost class (Form) and not the other classes (like Info and FormGroup. This is what I like to do:
Partial Public Class Form
Public Sub Init()
Me.Info = New Info
Me.FormGroup = New FormGroup
Me.Info.Init()
Me.FormGroup.Init()
End Sub
End Class
Partial Public Class Info
Public Sub Init()
Me.FormYear = New FormYear
Me.ChangeForm = New ChangeForm
Me.changeForm.Init()
End Sub
But I can’t write
Me.Info = New Info
Me.FormGroup = New FormGroup
because it is arrays with classes. How can I do it in my Form and Info class?
Thanks in advance.
You must first create an array, then loop over the array and assign each element. Also, unless you have a good, strong reason, do this in the constructor rather than a separate init method.
Public Class Form
Public Sub New()
'In VB, you give the max index, not the length.
'I prefer listing this as (whatever I want for length) - 1
Me.Info = New Info(size - 1) {}
For i = 0 to size - 1
Me.Info(i) = New Info()
Next
'similarly for other fields
End Sub
End Class
Alternatively, if you find yourself with a lot of array fields, and they all have default constructors, you could create a FixedCollection class that would encapsulate the repetitive initialization code.
Public Class FixedCollection(Of T As New)
Inherits Collection(Of T)
Public Sub New(ByVal size As Integer)
MyBase.New(New T(size - 1) {})
For i = 0 to size - 1
Me.Items(i) = New T()
Next
End Sub
'alternate constructors if you need additional initialization
'beyond construction of each element
Public Sub New(ByVal size As Integer, ByVal creator As Func(Of T))
MyBase.New(New T(size - 1) {})
If creator Is Nothing Then Throw New ArgumentNullException("creator")
For i = 0 to size - 1
Me.Items(i) = creator()
Next
End Sub
'this overload allows you to include the index in the collection
'if it would matter to creation
Public Sub New(ByVal size As Integer, ByVal creator As Func(Of Integer, T))
MyBase.New(New T(size - 1) {})
If creator Is Nothing Then Throw New ArgumentNullException("creator")
For i = 0 to size - 1
Me.Items(i) = creator(i)
Next
End Sub
'other collection overrides as needed here
End Class
EDIT: Added constructor overloads for when an element constructor is not enough.
If you only use the constructors with a creator parameter, you could remove the New constraint on T.
Use the overloads as follows:
Public Class Form
Private InfoField As New FixedCollection(Of Info)(10,
Function()
Dim ret As New Info()
ret.Init()
End Function)
End Class
Based on your comments, it seems like the Init methods are an unfortunate necessity. If possible, I would recommend that you find a way to get the generated constructor changed to call this method (defined in the generated code using partial methods) for you rather than forcing you to call it yourself.
You can initialize an Array of a Class like this:
Public FieldTypes As FieldTypeInfo() =
{
New FieldTypeInfo("Byte", 1),
New FieldTypeInfo("Int16", 2),
New FieldTypeInfo("Int32", 3),
New FieldTypeInfo("Integer", 3),
New FieldTypeInfo("Int64", 4),
New FieldTypeInfo("UInt16", 5),
New FieldTypeInfo("UInt32", 6),
New FieldTypeInfo("UInteger", 6),
New FieldTypeInfo("UInt64", 7)
}