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 need some help learning how to handle rolling up data by hierarchy groupings in VBA (PivotTables and even tables are not going to be sufficient due to "end-user" limitations).
I have granular data that with three levels of groupings: Parent, Child, Grain. A Parent may have more than 1 Child; and each Child may have more than 1 Grain. I need to take the universe of granular data and perform some calculations and then produce reports a the Parent and Child levels. For illustrative purposes, below are hypothetical structure/layout of source and desired outputs.
I've explored using Dictionaries and Collections, but neither seems to have the ability to restrict to unique/distinct relationships. For example, Dictionary will restrict to distinct Keys but will allow repetitive string values.
For example: Plants: Edible_Or_Not / Classification / Type / item
Edible / Fruit / Apple / Granny Smith
Edible / Fruit / Apple / Red Delicious
Edible / Vegetable / Asparagus / Asparagus
Nonedible / Tree / Maple / Red
Summaries:
1) Edible composed of Fruit and Vegetable
2) Fruit composed of Apple
3) Apple composed of Granny Smith and Red Delicious.
Below are the layouts more accurately representing my data.
Source:|||||
Parent Category Label|Child Category Label|Granular Label|DataPoint1|DataPoint2…|DataPoint3
---|---|---|---|---|---|
String A|String z|string z.g1.g2.g3|5|FALSE|1/1/1960
String A|String y|String y.g1.g2.g3|0|TRUE|1/2/1970
String B|String w|String w.g1.g2.g3|0|TRUE|9/5/1980
String C|String m|String m.g1.g2.g3|100|TRUE|1/1/1949
String C|String m|String m.g1a.g2.g3|2|FALSE|2/14/2008
String C|String n|String n.g1.g2.g3|2|TRUE|1/1/1950
String C|String o|String o.g1.g2.g3|0|FALSE|1/1/1905
String C|String o|String o.g1a.g2a.g3|0|FALSE|3/1/1977
String C|String p|String p.g1.g2.g3|1|FALSE|4/1/2000
Rollup Need Example #1||||
Parent|Distinct Children Count|Child1|Child 2|….Child(# - last)
---|---|---|---|---|
String A|2|String Z|String Y||
String B|1|String w|||
String C|4|String m|String n|...String p|
Rollup Need Example #2||||
Parent|Calculated Value ->|Sum DataPoint1 if and only if: (DataPoint 2 = "T" OR (inclusive) DataPoint1 <>0 )AND where DataPoint3 >=1/1/1950
---|---|---|---|
A|5||||
B|0||||
C|5||||
I'm going to assume you have three ListObjects on three sheets in an Excel Workbook.
Sheet1 (tblParent)
Item
A
B
C
Sheet2 (tblChild)
Item Parent
z A
y A
w B
m C
n C
o C
p C
Sheet3 (tblGrain)
Grain Parent Data1 Data2 Data3
y.g1.g2.g3 y 0 TRUE 1/2/1970
w.g1.g2.g3 w 0 TRUE 9/5/1980
m.g1.g2.g3 m 100 TRUE 1/1/1949
n.g1.g2.g3 n 2 TRUE 1/1/1950
I would create six class modules named CParent, CParents, CChild, CChildren, CGrain, CGrains.
CParents
Private mcolParents As Collection
Private Sub Class_Initialize()
Set mcolParents = New Collection
End Sub
Private Sub Class_Terminate()
Set mcolParents = Nothing
End Sub
Public Property Get NewEnum() As IUnknown
Set NewEnum = mcolParents.[_NewEnum]
End Property
Public Sub Add(clsParent As CParent)
If clsParent.ParentID = 0 Then
clsParent.ParentID = Me.Count + 1
End If
mcolParents.Add clsParent, CStr(clsParent.ParentID)
End Sub
Public Property Get Parent(vItem As Variant) As CParent
Set Parent = mcolParents.Item(vItem)
End Property
Public Property Get Count() As Long
Count = mcolParents.Count
End Property
Public Sub FillFromRange(ByRef rParents As Range, ByRef rChildren As Range, ByRef rGrains As Range)
Dim vaParents As Variant
Dim i As Long
Dim clsParent As CParent
vaParents = rParents.Value
For i = LBound(vaParents, 1) To UBound(vaParents, 1)
Set clsParent = New CParent
With clsParent
.Name_ = vaParents(i, 1)
End With
Me.Add clsParent
clsParent.Children.FillFromRange rChildren, clsParent.Name_, rGrains
Next i
End Sub
CParent
Private mlParentID As Long
Private msName_ As String
Private mclsChildren As CChildren
Public Property Set Children(ByVal clsChildren As CChildren): Set mclsChildren = clsChildren: End Property
Public Property Get Children() As CChildren: Set Children = mclsChildren: End Property
Public Property Let ParentID(ByVal lParentID As Long): mlParentID = lParentID: End Property
Public Property Get ParentID() As Long: ParentID = mlParentID: End Property
Public Property Let Name_(ByVal sName_ As String): msName_ = sName_: End Property
Public Property Get Name_() As String: Name_ = msName_: End Property
Private Sub Class_Initialize()
Set mclsChildren = New CChildren
End Sub
Private Sub Class_Terminate()
Set mclsChildren = Nothing
End Sub
CChildren
Private mcolChildren As Collection
Private Sub Class_Initialize()
Set mcolChildren = New Collection
End Sub
Private Sub Class_Terminate()
Set mcolChildren = Nothing
End Sub
Public Property Get NewEnum() As IUnknown
Set NewEnum = mcolChildren.[_NewEnum]
End Property
Public Sub Add(clsChild As CChild)
If clsChild.ChildID = 0 Then
clsChild.ChildID = Me.Count + 1
End If
mcolChildren.Add clsChild, CStr(clsChild.ChildID)
End Sub
Public Property Get Child(vItem As Variant) As CChild
Set Child = mcolChildren.Item(vItem)
End Property
Public Property Get Count() As Long
Count = mcolChildren.Count
End Property
Public Sub FillFromRange(ByRef rRng As Range, ByVal sParentName As String, ByRef rGrains As Range)
Dim vaValues As Variant
Dim i As Long
Dim clsChild As CChild
vaValues = rRng.Value
For i = LBound(vaValues, 1) To UBound(vaValues, 1)
If vaValues(i, 2) = sParentName Then
Set clsChild = New CChild
With clsChild
.Name_ = vaValues(i, 1)
End With
Me.Add clsChild
clsChild.Grains.FillFromRange rGrains, clsChild.Name_
End If
Next i
End Sub
CChild
Private mlChildID As Long
Private msName_ As String
Private mclsGrains As CGrains
Public Property Set Grains(ByVal clsGrains As CGrains): Set mclsGrains = clsGrains: End Property
Public Property Get Grains() As CGrains: Set Grains = mclsGrains: End Property
Public Property Let ChildID(ByVal lChildID As Long): mlChildID = lChildID: End Property
Public Property Get ChildID() As Long: ChildID = mlChildID: End Property
Public Property Let Name_(ByVal sName_ As String): msName_ = sName_: End Property
Public Property Get Name_() As String: Name_ = msName_: End Property
Private Sub Class_Initialize()
Set mclsGrains = New CGrains
End Sub
Private Sub Class_Terminate()
Set mclsGrains = Nothing
End Sub
CGrains
Private mcolGrains As Collection
Private Sub Class_Initialize()
Set mcolGrains = New Collection
End Sub
Private Sub Class_Terminate()
Set mcolGrains = Nothing
End Sub
Public Property Get NewEnum() As IUnknown
Set NewEnum = mcolGrains.[_NewEnum]
End Property
Public Sub Add(clsGrain As CGrain)
If clsGrain.GrainID = 0 Then
clsGrain.GrainID = Me.Count + 1
End If
mcolGrains.Add clsGrain, CStr(clsGrain.GrainID)
End Sub
Public Property Get Grain(vItem As Variant) As CGrain
Set Grain = mcolGrains.Item(vItem)
End Property
Public Property Get Count() As Long
Count = mcolGrains.Count
End Property
Public Sub FillFromRange(ByRef rRng As Range, ByVal sChildName As String)
Dim vaValues As Variant
Dim i As Long
Dim clsGrain As CGrain
vaValues = rRng.Value
For i = LBound(vaValues, 1) To UBound(vaValues, 1)
If vaValues(i, 2) = sChildName Then
Set clsGrain = New CGrain
With clsGrain
.Data1 = vaValues(i, 3)
.Data2 = vaValues(i, 4)
.Data3 = vaValues(i, 5)
End With
Me.Add clsGrain
End If
Next i
End Sub
CGrain
Private mlGrainID As Long
Private mlData1 As Long
Private mbData2 As Boolean
Private mdtData3 As Date
Public Property Let GrainID(ByVal lGrainID As Long): mlGrainID = lGrainID: End Property
Public Property Get GrainID() As Long: GrainID = mlGrainID: End Property
Public Property Let Data1(ByVal lData1 As Long): mlData1 = lData1: End Property
Public Property Get Data1() As Long: Data1 = mlData1: End Property
Public Property Let Data2(ByVal bData2 As Boolean): mbData2 = bData2: End Property
Public Property Get Data2() As Boolean: Data2 = mbData2: End Property
Public Property Let Data3(ByVal dtData3 As Date): mdtData3 = dtData3: End Property
Public Property Get Data3() As Date: Data3 = mdtData3: End Property
All this has done so far is to create three objects, establish relationships between them, and provide a way to fill them with data from an Excel range.
The relationships are established in the single object classes (not the plural ones). The CParent class has a property that holds a CChildren collection class. All of the children for that parent are stored in that class. The CChildren class holds a bunch of CChild objects. Each CChild object has a property CGrains that holds all the grains for that child. This is a lot of setup, but the payoff is coming.
Next, in a standard module, I want to create the procedure that fills the classes.
Public gclsParents As CParents
Public Sub Initialize()
Set gclsParents = New CParents
gclsParents.FillFromRange Sheet1.ListObjects(1).DataBodyRange, Sheet2.ListObjects(1).DataBodyRange, Sheet3.ListObjects(1).DataBodyRange
End Sub
I create a Public variable for the top collection class so it doesn't go out of scope. In Intialize, I instantiate the top collection class variable and call the FillFromRange method. I pass it my three Excel tables and the code fills in the all the classes.
Now lets say you wanted to create a procedure that listed all parents, a count of their children, and a list of their children.
Public Sub ListChildren()
Dim sh As Worksheet
Dim vaWrite As Variant
If gclsParents Is Nothing Then Initialize
Set sh = ThisWorkbook.Worksheets.Add
vaWrite = gclsParents.ChildListToRange
sh.Range("A1").Resize(UBound(vaWrite, 1), UBound(vaWrite, 2)).Value = vaWrite
End Sub
My CParents instance (held in gclsParents) returns an array that is dumped to a new sheet. The output looks like
A 2 z,y
B 1 w
C 4 m,n,o,p
Now you have to create the ChildListToRange method. Add this to the CParents class
Public Property Get ChildListToRange() As Variant
Dim aReturn() As Variant
Dim clsParent As CParent
Dim lCnt As Long
ReDim aReturn(1 To Me.Count, 1 To 3)
For Each clsParent In Me
lCnt = lCnt + 1
aReturn(lCnt, 1) = clsParent.Name_
aReturn(lCnt, 2) = clsParent.Children.Count
aReturn(lCnt, 3) = clsParent.ChildListDelimited(",")
Next clsParent
ChildListToRange = aReturn
End Property
The first two columns in the array are already defined, but we need to create a ChildListDelimited property in the CParent class. Add this to CParent
Public Property Get ChildListDelimited(ByVal sDelim As String) As String
Dim clsChild As CChild
Dim aReturn() As String
Dim lCnt As Long
ReDim aReturn(1 To Me.Children.Count)
For Each clsChild In Me.Children
lCnt = lCnt + 1
aReturn(lCnt) = clsChild.Name_
Next clsChild
ChildListDelimited = Join(aReturn, sDelim)
End Property
You supply a delimiter, this property returns a string of all the children separated by that delimiter.
And that's it. Your first report is done. Next, you want to create a report that sums up Data1 with certain criteria. Create this procedure in a standard module
Public Sub SummarizeValues()
Dim sh As Worksheet
Dim vaWrite As Variant
Dim clsToSum As CParents
If gclsParents Is Nothing Then Initialize
Set sh = ThisWorkbook.Worksheets.Add
Set clsToSum = gclsParents.FilterByData2(True).FilterByData3(DateSerial(1950, 1, 1), ">=")
vaWrite = clsToSum.SummarizeGrainValues
sh.Range("A1").Resize(UBound(vaWrite, 1), UBound(vaWrite, 2)).Value = vaWrite
End Sub
That looks a lot like the first procedure except that the CParents property that returns the array (to be written to a worksheet) is different. Also, we do some filtering. In the first procedure, we wanted every parent. Now we only want parents that meet certain criteria. For that, create a couple of FilterBy properties. In CParents add
Public Property Get FilterByData2(ByVal lData As Long) As CParents
Dim clsParent As CParent
Dim clsNewParent As CParent
Dim clsChild As CChild
Dim clsReturn As CParents
Set clsReturn = New CParents
For Each clsParent In Me
Set clsNewParent = New CParent
clsNewParent.Name_ = clsParent.Name_
Set clsNewParent.Children = clsParent.Children.FilterByData2(lData)
If clsNewParent.Children.Count > 0 Then
clsReturn.Add clsNewParent
End If
Next clsParent
Set FilterByData2 = clsReturn
End Property
This is a common filtering property. It takes a big CParents instance (gclsParents in this case) and returns a smaller one. If it finds children that meet the criteria, it adds the parent to the return class. Otherwise it doesn't. But you'll need to pass that criteria down to the children. Add this to the CChildren class
Public Property Get FilterByData2(ByVal lData As Long) As CChildren
Dim clsChild As CChild
Dim clsNewChild As CChild
Dim clsGrain As CGrain
Dim clsReturn As CChildren
Set clsReturn = New CChildren
For Each clsChild In Me
Set clsNewChild = New CChild
clsNewChild.Name_ = clsChild.Name_
Set clsNewChild.Grains = clsChild.Grains.FilterByData2(lData)
If clsNewChild.Grains.Count > 0 Then
clsReturn.Add clsNewChild
End If
Next clsChild
Set FilterByData2 = clsReturn
End Property
And add this to the CGrains class
Public Property Get FilterByData2(ByVal lData As Long) As CGrains
Dim clsGrain As CGrain
Dim clsReturn As CGrains
Set clsReturn = New CGrains
For Each clsGrain In Me
If clsGrain.Data2 = lData Then
clsReturn.Add clsGrain
End If
Next clsGrain
Set FilterByData2 = clsReturn
End Property
All that returns a CParents instance with the only the parents that eventually have a grain with true in Data2.
From that already smaller CParents instance, we tack on another filter. Add this to CParents
Public Property Get FilterByData3(ByVal dtData As Date, ByVal sComp As String) As CParents
Dim clsParent As CParent
Dim clsNewParent As CParent
Dim clsChild As CChild
Dim clsReturn As CParents
Set clsReturn = New CParents
For Each clsParent In Me
Set clsNewParent = New CParent
clsNewParent.Name_ = clsParent.Name_
Set clsNewParent.Children = clsParent.Children.FilterByData3(dtData, sComp)
If clsNewParent.Children.Count > 0 Then
clsReturn.Add clsNewParent
End If
Next clsParent
Set FilterByData3 = clsReturn
End Property
Because this filter uses an inequality, it gets a little more complicated as we'll see in a minute. For now, add this to CChildren
Public Property Get FilterByData3(ByVal dtData As Date, ByVal sComp As String) As CChildren
Dim clsChild As CChild
Dim clsNewChild As CChild
Dim clsGrain As CGrain
Dim clsReturn As CChildren
Set clsReturn = New CChildren
For Each clsChild In Me
Set clsNewChild = New CChild
clsNewChild.Name_ = clsChild.Name_
Set clsNewChild.Grains = clsChild.Grains.FilterByData3(dtData, sComp)
If clsNewChild.Grains.Count > 0 Then
clsReturn.Add clsNewChild
End If
Next clsChild
Set FilterByData3 = clsReturn
End Property
And add this to CGrains
Public Property Get FilterByData3(ByVal dtData As Date, ByVal sComp As String) As CGrains
Dim clsGrain As CGrain
Dim clsReturn As CGrains
Dim bAdd As Boolean
Set clsReturn = New CGrains
For Each clsGrain In Me
Select Case sComp
Case ">="
bAdd = clsGrain.Data3 >= dtData
Case ">"
bAdd = clsGrain.Data3 > dtData
Case "<"
bAdd = clsGrain.Data3 < dtData
Case "<="
bAdd = clsGrain.Data3 <= dtData
Case Else
bAdd = clsGrain.Data3 = dtData
End Select
If bAdd Then
clsReturn.Add clsGrain
End If
Next clsGrain
Set FilterByData3 = clsReturn
End Property
You can see in CGrains that I have to use a Select Case to figure out what inequality you want. But other that wrinkle, it does the same thing as the first filter.
Now you have a variable clsToSum that is a CParents instance that only contains parents you want. You've already done the filtering, now all you have to do it sum stuff up. Add this to CParents
Public Property Get SummarizeGrainValues() As Variant
Dim clsParent As CParent
Dim aReturn() As Variant
Dim lCnt As Long
ReDim aReturn(1 To Me.Count, 1 To 2)
For Each clsParent In Me
lCnt = lCnt + 1
aReturn(lCnt, 1) = clsParent.Name_
aReturn(lCnt, 2) = clsParent.SumData1
Next clsParent
SummarizeGrainValues = aReturn
End Property
Now you have to add SumData1 to CParent
Public Property Get SumData1() As Long
Dim lReturn As Long
Dim clsChild As CChild
Dim clsGrain As CGrain
For Each clsChild In Me.Children
For Each clsGrain In clsChild.Grains
lReturn = lReturn + clsGrain.Data1
Next clsGrain
Next clsChild
SumData1 = lReturn
End Property
That loops through all the grains in all the children and adds them up. The output looks like
A 0
B 0
C 2
Now that the infrastructure is done, you can create any manner of report you want. You simply have to set up whatever filters you need and any aggregation properties you want to report.
I probably should have said this at the top, but if you put these three tables in a proper relational database, you can accomplish all this with two fairly short SQL statements.
If you want to see it all together in a workbook, download this http://dailydoseofexcel.com/excel/ClassParentChildGrains.zip
Custom classes would allow you to create a hierarchy, the example class below is to get you started.
A parent object can place child objects within the container collection and then perform rollup calculations aggregating all objects within the collection.
Assuming you place child objects within the collection you could place grain objects within their container also and create a hierarchy as suits.
Private pContainer As New Collection
Private pTitle As String
Private pValueToSum As Double
Public Property Get Container() As Collection
Set Container = pContainer
End Property
Public Property Let Container(value As Collection)
Set pContainer = value
End Property
Public Property Get GetTotals() As Double
Dim dbl As Double
Dim var As Variant
For Each var In Me.Container
dbl = dbl + var.ValueToSum
Next var
GetTotals = dbl
End Property
I have a Serializable class called SettingsForProgram this class contains a list of string called ServerList
I am using this class to save settings for myprogram (username , password , colors , etc..) but when i try to save a list the same way then add -or get- items from it i get object reference not set to instance of object so how can i create a new instance of the class when converting it
To understand what i mean here are some codes :
The class :
<Serializable()>
Public Class SettingsForProgram
Private Namev As String = ""
Private pwv As String = ""
Public LocationsList As New List(Of String)
Private Savev As New Boolean()
Public Property LoginName As String
Get
Return Namev
End Get
Set(value As String)
Namev = value
End Set
End Property
Public Property LoginPassword As String
Get
Return pwv
End Get
Set(value As String)
pwv = value
End Set
End Property
Public Property SaveLogin As Boolean
Get
Return Savev
End Get
Set(value As Boolean)
Savev = value
End Set
End Property
Public Sub New()
LocationsList = New List(Of String)
End Sub
End Class
To load settings:(where i want to initialize the new instance of the class)
public MySettings as new SettingsForProgram
Public Sub LoadSettings()
Dim formatter As New BinaryFormatter()
Dim data As Byte() = File.ReadAllBytes(savepath)
Dim ms As New MemoryStream(data)
MySettings = CType(formatter.Deserialize(ms), SettingsForProgram)
End Sub
To save settings :
Public Sub SaveSettings()
Dim bf As New BinaryFormatter()
Dim ms As New MemoryStream()
If MySettings.LoginName = Nothing Then
MySettings.LoginName = "name"
ElseIf MySettings.LoginPassword = Nothing Then
MySettings.LoginPassword = "password"
End If
bf.Serialize(ms, MySettings)
Dim mySaveState As Byte() = ms.ToArray()
File.WriteAllBytes(savepath, mySaveState)
End Sub
I made a quick test like this
button 1 : save
MySettings.LocationsList.AddRange({"test1", "test2", "test3"}) <<<< where i get the error
SaveSettings()
button 2 : load
LoadSettings()
MsgBox(MySettings.LocationsList(1))
thanks to #Steve i now know the problem
, the solution is to do like i did with name and password saving ,
just added this to the save Settings
If MySettings.LocationsList Is Nothing Then
MySettings.LocationsList = New List(Of String)
MySettings.LocationsList.Add("Location 1")
End If
and every thing worked
final code
Public Sub SaveSettings()
Dim bf As New BinaryFormatter()
Dim ms As New MemoryStream()
If MySettings.LoginName = Nothing Then
MySettings.LoginName = "name"
ElseIf MySettings.LoginPassword = Nothing Then
MySettings.LoginPassword = "password"
End If
If MySettings.LocationsList Is Nothing Then
MySettings.LocationsList = New List(Of String)
MySettings.LocationsList.Add("Location 1")
End If
bf.Serialize(ms, MySettings)
Dim mySaveState As Byte() = ms.ToArray()
File.WriteAllBytes(savepath, mySaveState)
End Sub
I am new to wpf and am going for an MCTS exam. I have searched for 2 days now on how to retrieve row column items in code. I have been able to insert data into the listview by creating a structure and adding row items via code.
Public Structure SimpleData
Public Property Txt1 As String
Get
Return mTxt1
End Get
Set(value As String)
mTxt1 = value
End Set
End Property
Private mTxt1 As String
Public Property Txt2 As String
Get
Return mTxt2
End Get
Set(value As String)
mTxt2 = value
End Set
End Property
Private mTxt2 As String
Public Property Txt3 As String
Get
Return mTxt3
End Get
Set(value As String)
mTxt3 = value
End Set
End Property
Private mTxt3 As String
End Structure
Public Structure MyData
Public Property Desc() As String
Get
Return m_Desc
End Get
Set(value As String)
m_Desc = Value
End Set
End Property
Private m_Desc As String
Public Property Progress() As Integer
Get
Return m_Progress
End Get
Set(value As Integer)
m_Progress = Value
End Set
End Property
Private m_Progress As Integer
Public Property ProgressText() As String
Get
Return m_ProgressText
End Get
Set(value As String)
m_ProgressText = Value
End Set
End Property
Private m_ProgressText As String
Public Property Pic() As String
Get
Return m_Pic
End Get
Set(value As String)
m_Pic = Value
End Set
End Property
Private m_Pic As String
End Structure
Private Sub Button2_Click(sender As System.Object, e As System.Windows.RoutedEventArgs) Handles Button2.Click
Dim sd As New SimpleData
sd.Txt1 = "Today is"
sd.Txt2 = "a good day"
sd.Txt3 = "O YES!"
listView1.Items.Add(sd)
End Sub
I want to be able to retrieve row(0).Item(0).ToString, which is how to retrieve it in win forms. Expecting a response. Thanks in advance
Dim constr As String = "Put your connection string here"
Dim ds As New DataSet
Dim con As New SqlClient.SqlConnection(constr)
con.Open()
Dim sqladap As New SqlClient.SqlDataAdapter("select * from tbl_Employee", con)
sqladap.Fill(ds)
For i As Integer = 0 To ds.Tables(0).Columns.Count - 1
ListView1.Columns.Add(ds.Tables(0).Columns(i).ToString())
Next
For i As Integer = 0 To ds.Tables(0).Rows.Count - 1
Dim listRow As New ListViewItem
listRow.Text = ds.Tables(0).Rows(i)(0).ToString()
For j As Integer = 1 To ds.Tables(0).Columns.Count - 1
listRow.SubItems.Add(ds.Tables(0).Rows(i)(j).ToString())
Next
ListView1.Items.Add(listRow)
Next
Read data from Listview :
Dim name, room, subject, date, period As String
If listviewName.SelectedItems.Count > 0 then
For i As Integer = 0 To listviewName.SelectedItems.Count - 1
'*********** transfer selected data on declare String variable ************'
name= listviewName.SelectedItems(i).SubItems(0).Text
room = listviewName.SelectedItems(i).SubItems(1).Text
subject = listviewName.SelectedItems(i).SubItems(2).Text
date= listviewName.SelectedItems(i).SubItems(3).Text
period= listviewName.SelectedItems(i).SubItems(4).Text
'*********** delete **************'
cmd1.Connection = MYSQLCON
MYSQLCON.Open()
cmd1.CommandText = "DELETE FROM tablename WHERE columnname = '" & name & "'"
reader = cmd1.ExecuteReader
MYSQLCON.Close()
Next
End If
I have found the answer by casting the listview item to the created structure SimpleData then looping through it
Dim getitems = CType(listView1.SelectedItem, SimpleData)
For Each mem In getitems.Txt1
MsgBox(mem.ToString)
Next
VB.NET 2010, .NET 4
Hello,
I've looked around and can't seem to find a solution to my problem. I have an EventLog object which inherits DataGridView and has a public variable EventList which is a List(Of EventLogItem). EventLogItem has seven properties which describe the event, including Index which is set to EventList.Count each time an entry is added (so, it should be unique). Everything has worked just fine until I tried to add an entry from a serial port DataReceived event handler upon which I receive the following exception:
An error occurred creating the form. See Exception.InnerException for details. The error is: An item with the same key has already been added.
Clicking 'View Details' and expanding the InnerException yields no more information. Here is some relevant code:
The EventLog class with its EventList:
Public Class EventLog
Inherits DataGridView
Public EventList As New List(Of EventLogItem)
..Column creation code, etc..
End Class
The EventLogItem class:
Public Class EventLogItem
Public Property Index As Integer
Public Property Timestamp As String
Public Property User As String = String.Empty
Public Property [Step] As String = String.Empty
Public Property Type As Types
Public Property Message As String
Public Property TypeIcon As Image
Public Enum Types
SeriousError = -2
NormalError = -1
Warning = 0
NormalEvent = 1
ImportantEvent = 2
ManualEntry = 3
End Enum
Private Sub New()
Me.Timestamp = DateTime.Now.ToString("MM/dd/yyyy HH:mm:ss.f")
Me.Type = Types.NormalEvent
SetTypeIcon()
End Sub
Public Sub New(ByVal Message As String)
Me.New()
Me.Message = Message
End Sub
Public Sub New(ByVal Message As String, ByVal User As String)
Me.New()
Me.Message = Message
Me.User = User
End Sub
Public Sub New(ByVal Message As String, ByVal User As String, ByVal Type As Types)
Me.New(Message, User)
Me.Type = Type
SetTypeIcon()
End Sub
Public Sub New(ByVal Message As String, ByVal User As String, ByVal Type As Types, ByVal [Step] As Integer)
Me.New(Message, User, Type)
Me.Step = ([Step] + 1).ToString
End Sub
Private Sub SetTypeIcon()
Select Case Me.Type
Case Types.NormalError
Me.TypeIcon = My.Resources.ErrorIcon
Case Types.SeriousError
Me.TypeIcon = My.Resources.ErrorIcon
Case Types.Warning
Me.TypeIcon = My.Resources.WarningIcon
Case Types.ManualEntry
Me.TypeIcon = My.Resources.ManualIcon
Case Else
Me.TypeIcon = My.Resources.OkayIcon
End Select
End Sub
End Class
Code for inserting an item into the event log:
Inside my main-form class:
Public Sub NewEventLogEntry(ByVal Message As String, ByVal ex As Exception, ByVal Type As EventLogItem.Types, ByVal IncludeProcessStepNumber As Boolean)
If IncludeProcessStepNumber Then
SafeInvokeControl(EventLog, Sub(x)
Dim FirstRow As Integer = x.FirstDisplayedScrollingRowIndex
Dim [Event] As New EventLogItem(Message, My.Settings.SelectedUser, Type, Device.CurrentProcessStep)
[Event].Index = x.RowCount + 1
x.EventList.Insert(0, [Event])
x.DataSource = GetType(List(Of EventLogItem))
x.DataSource = x.EventList
x.SetRowStyles()
If FirstRow >= 0 And FirstRow < x.RowCount Then x.FirstDisplayedScrollingRowIndex = FirstRow
End Sub)
Else
SafeInvokeControl(EventLog, Sub(x)
Dim FirstRow As Integer = x.FirstDisplayedScrollingRowIndex
Dim [Event] As New EventLogItem(Message, My.Settings.SelectedUser, Type)
[Event].Index = x.RowCount + 1
x.EventList.Insert(0, [Event])
x.DataSource = GetType(List(Of EventLogItem))
x.DataSource = x.EventList
x.SetRowStyles()
If FirstRow >= 0 And FirstRow < x.RowCount Then x.FirstDisplayedScrollingRowIndex = FirstRow
End Sub)
End If
If Type < EventLogItem.Types.Warning Then
Dim ErrorBox As New ErrorBox
Dim ErrorBoxThread As New Threading.Thread(AddressOf ErrorBox.ShowDialog)
ErrorBoxThread.IsBackground = True
ErrorBox.Exception = ex
If Type = EventLogItem.Types.NormalError Then
ErrorBox.Type = ErrorBox.Types.Error
ErrorBox.Message = Message
ElseIf Type = EventLogItem.Types.SeriousError Then
ErrorBox.Type = ErrorBox.Types.SeriousError
ErrorBox.Message = Message & vbNewLine & vbNewLine & "This is a serious error and indicates that the program is " & _
"unstable. The source of this error should be corrected before this program is used for anything important."
End If
StopMasterTimer()
ErrorBoxThread.Start()
End If
End Sub
end main-form class snippet
The code that's causing the problem (ch4cp is my namespace. this code resides in a class other than my main-form class):
Inside a serial port device class:
<Runtime.CompilerServices.MethodImplAttribute(Runtime.CompilerServices.MethodImplOptions.Synchronized)> _
Private Shared Sub Port_DataReceived(ByVal sender As Object, ByVal e As System.IO.Ports.SerialDataReceivedEventArgs) Handles Port.DataReceived
..some code..
ch4cp.NewEventLogEntry("testing")
..some more code..
End Sub
End serial port device class snippet
Any ideas?
Thanks a lot in advance.
It sounds like you are getting a thread exception error in your code somewhere. The threading problem will cause other issues and not appear until you step through the code and look at each line being executed.
Try the following at the beginning of your code block to try to identify the problem.
Control.CheckForIllegalCrossThreadCalls = false