Currently I'm having an issue/Struggling to understand how to pull the information out of a Class Module.
How I understand it is if a Class Module was an Excel sheet an instance would be a row and the public property would be the columns I have issued this problem before see link (Retrieving information from a Class module VB.Net) here is where i am with the code
In side my Class Module
Public Class tDCVillains
Public Property Gothem As Integer
Public Property metropolis as Integer
End Class
Inserting the Information into the Class Module
Sub GrabAccessInfo()
Dim DCVillains As New tDCVillains
Dim VillainsCollection As New Collection
DCVillains.Gothem = rst("Gothem").Value
DCVillains.metropolis = rst("metropolis").Value
VillainsCollection.Add(DCVillains)
rst.MoveNext()
End Sub
Retrieving information out of the Class Module
Sub RackSlotAccess(DCVillains As tDCVillains)
For Each tDCVillains As System.Reflection.PropertyInfo In tDCVillains ' its not liking tDCVillains
Dim ObjGothem = DCVillains.Gothem
Dim Objmetropolis = DCVillains.metropolis
If ObjGothem >= 1 Then
InsertGothemVillains(ObjGothem, 32, "I", Slot, Rack)
End If
If Objmetropolis >= 1 Then
InsertmetropolisVillains(Objmetropolis, 16, "I", Slot, Rack)
End If
Next
End Sub
its the for each statement the code doesn't like but i cant figure out why?
It seems as if you want to loop the properties of the type tDCVillains. You can use Type.GetProperties:
Sub RackSlotAccess(DCVillains As tDCVillains)
Dim type = GetType(tDCVillains)
For Each tDCVillains As System.Reflection.PropertyInfo In type.GetProperties()
Dim ObjGothem = DCVillains.Gothem
Dim Objmetropolis = DCVillains.metropolis
If ObjGothem >= 1 Then
InsertGothemVillains(ObjGothem, 32, "I", Slot, Rack)
End If
If Objmetropolis >= 1 Then
InsertmetropolisVillains(Objmetropolis, 16, "I", Slot, Rack)
End If
Next
End Sub
Related
I have a Public Class Field_Data
Public Class Field_Data
#Region "Location_v1"
Public Property sample_name As String
Public Property analysis_date As String
I can instantiate the class and add data to it for multiple subsets
For iCol = 7 To LastCol
Dim myFDData As New Field_Data
myFDData.sample_name = wkbRep.Worksheets(0).Range(31, iCol).Value
myFDData.analysis_date = wkbRep.Worksheets(0).Range(32, iCol).Value
I add each filled class to as List
Dim Summary_Data As New List Of(Field_Data)
Using
Summary_Data.Add(myFDData)
Fills the list
I then want to iterate through list to write summary file
For Each MyFieldItem as Field_Data In Summary_Data
Returns empty values
What am I doing wrong? TIL
I am not sure where you are going wrong because yo didn't include all the code. See if this matches your pattern. I assume you are retrieving data from an Excel. That can be a bit tricky but you didn't provide the code. Separating the work into 2 methods may help you see where it is going wrong. Set a break point and step through observing the values of the variables.
Private Summary_Data As New List(Of Field_Data)
Private Sub AddDataToSummaryList()
For iCol = 7 To LastCol
Dim myFDData As New Field_Data
myFDData.sample_name = wkbRep.Worksheets(0).Range(31, iCol).Value
myFDData.analysis_date = wkbRep.Worksheets(0).Range(32, iCol).Value
Summary_Data.Add(myFDData)
Next
End Sub
Private Sub WriteListToFile()
For Each MyFieldItem As Field_Data In Summary_Data
'Your code to write file here
Next
End Sub
I reckon you've added all your things to the wrong list
Here's a simple example
Imports System
imports System.Collections.Generic
Public Module Module1
Dim x as new List(of String)
Public Sub Main()
Dim x as new List(of String)
x.Add("")
HowMany()
End Sub
sub HowMany()
Console.Out.WriteLine(x.Count)
end sub
End Module
You have a new List X at class level and you made another one also called X at a more local level. You filled the local one, then elsewhere used the class level one.
The code above prints 0 because nothing is ever added to the class level list
Ok to start off, I read through this.
It is close although it doesn't answer my specific question. This talks about taking smaller collections and adding items to a larger main collection. Then destroying the smaller collection.
I have two definitions under Class Modules.
TimeDet
Option Explicit
Public recDate As String
Public recQty As String
Public recDieNo As String
Public recCatID As String
Public recCatName As String
Public recGroupID As String
Public recGroupName As String
TimeRec
Option Explicit
Private objTimeRec As Collection
Private Sub Class_Initialize()
Set objTimeRec = New Collection
End Sub
Private Sub Class_Terminate()
Set objTimeRec = Nothing
End Sub
Public Property Get NewEnum() As IUnknown
Set NewEnum = objTimeRec.[_NewEnum]
End Property
Public Sub Add(obj As TimeDet)
objTimeRec.Add obj
End Sub
Public Sub Remove(Index As Variant)
objTimeRec.Remove Index
End Sub
Public Property Get Item(Index As Variant) As TimeDet
Set Item = objTimeRec.Item(Index)
End Property
Property Get Count() As Long
Count = objTimeRec.Count
End Property
Public Sub Clear()
Set objTimeRec = New Collection
End Sub
Public Sub FillFromArray(Arr As Variant)
Dim i As Long, obj As TimeDet
For i = 1 To UBound(Arr)
Set obj = New TimeDet
obj.recDate = Arr(i, 1)
obj.recQty = Arr(i, 2)
obj.recDieNo = Arr(i, 3)
obj.recCatID = Arr(i, 4)
obj.recCatName = Arr(i, 5)
obj.recGroupID = Arr(i, 6)
obj.recGroupName = Arr(i, 7)
Me.Add obj
Next
End Sub
Then in the code I am using it this way:
Sub Test()
Dim RecSet1 As TimeRec, Record As TimeDet
Dim fSet1 As TimeRec, fRecord As TimeDet
Dim repArray() As Variant
Dim startDT As Date, endDT As Date, dieNo As String
repArray() = Sheet4.Range("A2:G" & Sheet4.Range("A2").End(xlDown).Row)
Set RecSet1 = New TimeRec
Set fSet1 = New TimeRec
RecSet1.FillFromArray (repArray())
startDT = "1-1-2015"
endDT = "1-1-2016"
dieNo = "16185"
For Each Record In RecSet1
If Record.recDate <= endDT And Record.recDate >= startDT And Record.recDieNo = dieNo Then
fSet1.Add (Record)
End If
Next
End Sub
I am getting an error when I try to add the Record object to the fSet1 object.
"Object doesn't support this method or property"
The Record object is Type TimeDet which as you can see up in the class module my Add method is expecting type TimeDet.
Either I am missing something very simple and have blinders on, or this is a bigger issue.
The array has 200,000 records roughly. I am attempting to create a smaller subset of filtered data. Maybe I am approaching this from the wrong way.
Your error is not at Add but at For Each
Most likely you copied your TimeRec Class. In VBA, you can't create enumerable classes inside the VBE (VBA IDE). There's a different way of creating Enumerable classes.
Open a notepad, copy all your class code and then add this attribute to NewEnum property Attribute NewEnum.VB_UserMemId = -4
Then import the class.
This is always hidden in VBA code, but can be seen in text editors.
Also add this attribute to Item property, it will make it default and allows syntax like ClassName(1)
Attribute Item.VB_UserMemId = 0
So , your code in text editor/ notepad should be:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Class1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private objTimeRec As Collection
Private Sub Class_Initialize()
Set objTimeRec = New Collection
End Sub
Private Sub Class_Terminate()
Set objTimeRec = Nothing
End Sub
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Set NewEnum = objTimeRec.[_NewEnum]
End Property
Public Sub Add(obj As Class2)
objTimeRec.Add obj
End Sub
Public Sub Remove(Index As Variant)
objTimeRec.Remove Index
End Sub
Public Property Get Item(Index As Variant) As Class2
Attribute Item.VB_UserMemId = 0
Set Item = objTimeRec.Item(Index)
End Property
Property Get Count() As Long
Count = objTimeRec.Count
End Property
Public Sub Clear()
Set objTimeRec = New Collection
End Sub
The answer to this particular problem was to remove the parenthesis form my Add method. That being said, the attribute info being hidden was really good info and would have probably contributed to the problem after I figured out that removing the parenthesis fixed it.
Currently I'm trying to store a bunch of integers/Strings in a Class inserting the information isn't a problem but for some reason i can't figure out how to retrieve the information
Public Class HardwareCards
Public Property RackAmount() As Integer
End class
Inserting the information
Sub GrabAccessInfo()
Dim Hardware As New HardwareCards
Dim HardwareCollection As New Collection
Hardware.RackAmount = rst("RackAmount").Value
End Sub
Retrieving the information
Sub RackSlotAccess()
Dim type As Type = HardwareCards.GetType()
Dim typename As Integer = type.FullName
If HardwareCards.Hardware.DI32 >= 1 Then 'Inserting 32 bit Digital input card(s)
InsertDigAddresses(HardwareCards.Hardware.DI32, 32, "I", Slot, Rack)
End If
End sub
What do i need to do to get the infomation out of the Class Module?
You're referencing the type when calling HardwareCards, and not an initialized object. Notice how in GrabAccessInfo you declare and initialize an instance of HardwareCards into the variable Hardware. In order to access the information you assigned to the object variable Hardware, you would need to reference it in RackSlotAccess.
Sub RackSlotAccess(hardware As HardwareCards)
'Perform logic, evaluations on hardware. Example:
Dim currentRackAmount = hardware.RackAmount
End Sub
I have created two classes, one being an interface for the other. Each time I try to instantiate Transition_Model I get:
Compile error: Object Module needs to implement '~' for interface'~'
To my understanding Implementing class is supposed to have a copy of all public subs, function, & properties. So I don't understant what is the problem here?
Have seen similar questions come up but either they refer to actual Sub or they include other complications making answer too complicated for me to understand.
Also note I tried changing Subs of Transition_Model to Private and add 'IModel_' in front of sub names(Just like top answer in second question I linked) but I still receive the same error.
IModel
Option Explicit
Public Enum Model_Types
Transition
Dummy
End Enum
Property Get M_Type() As Model_Types
End Property
Sub Run(Collat As Collateral)
End Sub
Sub Set_Params(key As String, value As Variant)
End Sub
Transition_Model
Option Explicit
Implements IModel
Private Transitions As Collection
Private Loan_States As Integer
Private Sub Class_Initialize()
Set Transitions = New Collection
End Sub
Public Property Get M_Type() As Model_Types
M_Type = Transition
End Property
Public Sub Run(Collat As Collateral)
Dim A_Transition As Transition
Dim New_Balance() As Double
Dim Row As Integer
For Row = 1 To UBound(Collat.Curr_Balance)
For Each A_Transition In Transitions
If A_Transition.Begining = i Then
New_Balance = New_Balance + Collat.Curr_Balance(Row) * A_Transition.Probability
End If
Next A_Transition
Next
End Sub
Public Sub Set_Params(key As String, value As Double)
Dim Split_key(1 To 2) As String
Dim New_Transition As Transition
Split_key = Split(key, "->")
Set New_Transition = New Transition
With New_Transition
.Begining = Split_key(1)
.Ending = Split_key(2)
.Probability = value
End With
Transitions.Add New_Transition, key
End Sub
Lastly the Sub I am using to test my class
Sub Transition_Model()
Dim Tested_Class As New Transition_Model
Dim Collat As New Collateral
'Test is the model type is correct
Debug.Assert Tested_Class.M_Type = Transition
'Test if Model without transition indeed does not affect balances of its collateral
Collat.Curr_Balance(1) = 0.5
Collat.Curr_Balance(2) = 0.5
Tested_Class.Run (Collat)
Debug.Assert ( _
Collat.Curr_Balance(1) = 0.5 And _
Collat.Curr_Balance(2) = 0.5)
End Sub
Actaully Per the second question I linked has the correct answer which I missed.
All subs need to start with 'IModel_' and rest ot the name has to match the name in IModel.
AND
This is the part i missed, you cannot use underscore in the Sub name.
I have created a sort function to allow a collection of instances of a custom object to be sorted based on one of the objects properties. Is it possible to extend the existing collections class in VBA? I do not believe inheritance is supported in VBA, so I am not sure how to go about this in the proper way. I could just create a new module and place the function in that module, but that doesn't seem like the best way of doing it.
Thanks for the responses. I ended up creating my own class which extends the Collections class in VBA. Below is the code if anyone is interested.
'Custom collections class is based on the Collections class, this class extendes that
'functionallity so that the sort method for a collection of objects is part of
'the class.
'One note on this class is that in order to make this work in VBA, the Attribute method has to be added
'manually. To do this, create the class, then export it out of the project. Open in a text editor and
'add this line Attribute Item.VB_UserMemId = 0 under the Item() function and this line
'Attribute NewEnum.VB_UserMemId = -4 under the NewEnum() function. Save and import back into project.
'This allows the Procedure Attribute to be recognized.
Option Explicit
Private pCollection As Collection
Private Sub Class_Initialize()
Set pCollection = New Collection
End Sub
Private Sub Class_Terminate()
Set pCollection = Nothing
End Sub
Function NewEnum() As IUnknown
Set NewEnum = pCollection.[_NewEnum]
End Function
Public Function Count() As Long
Count = pCollection.Count
End Function
Public Function item(key As Variant) As clsCustomCollection
item = pCollection(key)
End Function
'Implements a selection sort algorithm, could likely be improved, but meets the current need.
Public Sub SortByProperty(sortPropertyName As String, sortAscending As Boolean)
Dim item As Object
Dim i As Long
Dim j As Long
Dim minIndex As Long
Dim minValue As Variant
Dim testValue As Variant
Dim swapValues As Boolean
Dim sKey As String
For i = 1 To pCollection.Count - 1
Set item = pCollection(i)
minValue = CallByName(item, sortPropertyName, VbGet)
minIndex = i
For j = i + 1 To pCollection.Count
Set item = pCollection(j)
testValue = CallByName(item, sortPropertyName, VbGet)
If (sortAscending) Then
swapValues = (testValue < minValue)
Else
swapValues = (testValue > minValue)
End If
If (swapValues) Then
minValue = testValue
minIndex = j
End If
Set item = Nothing
Next j
If (minIndex <> i) Then
Set item = pCollection(minIndex)
pCollection.Remove minIndex
pCollection.Add item, , i
Set item = Nothing
End If
Set item = Nothing
Next i
End Sub
Public Sub Add(value As Variant, key As Variant)
pCollection.Add value, key
End Sub
Public Sub Remove(key As Variant)
pCollection.Remove key
End Sub
Public Sub Clear()
Set m_PrivateCollection = New Collection
End Sub
One popular option is to use an ADO disconnected recordset as a sort of hyperpowered collection/dictionary object, which has built-in support for Sort. Although you are using ADO, you don't need a database.
I would create a wrapper class that exposes the collection object's properties, substituting the sort function with your own.