Creating Collection with Class Objects - vba

Im trying to consolodate my code a bit by making the code a little more polymorphic. I have a userform in which I have 5 tabs. Each tab has 3 columns in which to place controls dynamically at run time.
I am looking to consolidate all of my Top and Left Positions for each control as i start building this form.
Right now I have variables like this.
Tab0StartFromTop
Tab1StartFromTop
Tab2StartFromTop
Tab3StartFromTop
Tab4StartFromTop
Tab0Col1Left
Tab0Col2Left
Tab0Col3Left
''you get the picture
What I'd like to do is something like this
Dim TabAttributes(0 To 4) As Collection
Dim ColumnAttributes As clsColumn ''clsColumn is a class object with properties for both .Top and .Left
Dim ColumnAttributeCollection As Collection
''Load Up my initial data. Distance from top will be incremented as I add controls
Set ColumnAttributes = New clsColumn
ColumnAttributes.Top = StartFromTop
ColumnAttributes.Left = StartFromLeft
''load all 3 objects into the (0) zero index for tab0
ColumnAttributeCollection(1).Add ColumnAttributes
ColumnAttributeCollection(2).Add ColumnAttributes
ColumnAttributeCollection(3).Add ColumnAttributes
''Now stick it inside my TabAttributes
TabAttributes(0).add ColumnAttributeCollection
so now I could access it like this, or in some way.
For each blah..
TabAttributes(MyControl.Tabindex).Column(MyControl.ColumnIndex).Top
TabAttributes(MyControl.Tabindex).Column(MyControl.ColumnIndex).Left
Next
also as I loop through each control I will need to adjust the top integer as more controls are added to that specific column on that specific tab.
TabAttributes(MyControl.Tabindex).Column(MyControl.ColumnIndex).Top = _
TabAttributes(MyControl.Tabindex).Column(MyControl.ColumnIndex).Top + 40
I hope that makes sense. Thanks in advance for the suggestions.

Personally I prefer using arrays over collections. Perhaps something like this might work for you:
Const lTop As Long = 0 'Use named variable to always work with Top attribute
Const lLeft As Long = 1 'Use named variable to always work with Left attribute
Dim lTabIndex As Long
Dim aTabColumns() As Variant
ReDim aTabColumns(0 To 4, 0 To 1)
'The first dimension (0 to 4) is for your tab numbers
'The second dimension (0 to 1) shows if you're working with the Top or Left attribute for that tab's column
'Example use: aTabColumns(1, lTop) = aTabColumns(1, lTop) + 40
'Example showing how to loop through the array and set initial values
For lTabIndex = LBound(aTabColumns, 1) To UBound(aTabColumns, 1)
aTabColumns(lTabIndex, lTop) = StartFromTop
aTabColumns(lTabIndex, lLeft) = StartFromLeft
Next lTabIndex

Finally got it to work properly using a dictionary
Dim TabAttributes As Dictionary
Dim ColumnAttributes As Dictionary
Dim Column1Info As clsColumn
Dim Column2Info As clsColumn
Dim Column3Info As clsColumn
Dim TabColumnIndex As Integer
Set Column1Info = New clsColumn
Set Column2Info = New clsColumn
Set Column3Info = New clsColumn
Set TabAttributes = New Dictionary
Set ColumnAttributes = New Dictionary
'set column offsets
Column1Info.Left = StartFromLeft
Column1Info.Top = StartFromTop
Column2Info.Left = StartFromLeft + Column1Width + ColumnGap
Column2Info.Top = StartFromTop
Column3Info.Left = StartFromLeft + Column1Width + ColumnGap * 2 + Column2Width
Column3Info.Top = StartFromTop
'add column offsets to class object
ColumnAttributes.Add 1, Column1Info
ColumnAttributes.Add 2, Column2Info
ColumnAttributes.Add 3, Column3Info
'add class object to each tab index
For TabColumnIndex = 0 To 4
TabAttributes.Add TabColumnIndex, ColumnAttributes
Next
So now I can get my data like this...
TabAttributes(MyControl.Tabindex)(MyControl.ColumnIndex).Top = 125
thanks for the help guys

Related

VB 2-Dimensional Array Item comparison to image

Why does the messagebox show "False"?
Dim images(4, 4) As Image
For rows = 0 To 4
For columns = 0 To 4
images(rows, columns) = My.Resources.kaboom
Next
Next
MessageBox.Show(images(3, 3).Equals(My.Resources.kaboom))
If you look at the code behind the kaboom property, you will see it creates a new object every time.
'''<summary>
''' Looks up a localized resource of type System.Drawing.Bitmap.
'''</summary>
Friend ReadOnly Property kaboom() As System.Drawing.Bitmap
Get
Dim obj As Object = ResourceManager.GetObject("kaboom", resourceCulture)
Return CType(obj,System.Drawing.Bitmap)
End Get
End Property
If you keep a reference to one object, it will be equal to true. It might also be faster since it doesn't need to create a new object.
Dim kaboom As Image = My.Resources.kaboom
Dim images(4, 4) As Image
For rows = 0 To 4
For columns = 0 To 4
images(rows, columns) = kaboom
Next
Next
MessageBox.Show(images(3, 3).Equals(kaboom))
Maybe you are already planning on doing this but here is a suggestion. If you are creating some sort of game, separate the display from the game logic. This mean, save the type of tile instead of the image and compare that. Later, you can add a bunch of different properties to a tile.
Const TYPE_KABOOM As Integer = 1
Dim tileType(4, 4) As Integer
For rows = 0 To 4
For columns = 0 To 4
tileType(rows, columns) = TYPE_KABOOM
Next
Next
MessageBox.Show(tileType(3, 3).Equals(TYPE_KABOOM))

VBA Powerpoint - Modify category names

I'm trying to modify category names of an existing chart in VBA powerpoint with the below code, but instead the category names are removed from the chart.
Dim mCatArray() As String
lngSeries = 0
Dim testvar As Variant
'Get the existing category names in an Array
'oSh = Shape element
For Each testvar In oSh.Chart.Axes(xlCategory).CategoryNames
strIn = ProperCaps(testvar & "", objRegex)
ReDim Preserve mCatArray(lngSeries)
'Do my changes and insert the category name in the Array
mCatArray(lngSeries) = strIn
lngSeries = lngSeries + 1
Next
'Assign the Changed Category array back - METHOD 1
For lngSeries = 1 To .Chart.SeriesCollection.Count
oSh.Chart.SeriesCollection(lngSeries).XValues = mCatArray
Next
'Assign the Changed Category array back - METHOD 2
oSh.Chart.Axes(xlCategory).CategoryNames = mCatArray
Both the method's don't seem to help. Any help is appreciated.

CorelDraw selecting specific shapes in a collection

I'm trying to build a small nesting Function inside of my current working system. What I am having trouble with is that when I add the third shape to the collection and try to position it based on the previous shape added to the collection, it still positions it based on the very first shape. What I end up with is the original in the original position and the copies stacked on top of one another.
Function ArrangeImages(ByRef scol1 As Collection, ByRef sA, sB As Shape)
Dim i, ii As Long
i = scol1.Count
ii = i - 1
If i = 1 Then
Set sB = scol1.Item(i)
End If
If scol1.Count > 1 Then
Set sA = scol1.Item(ii)
Set sB = scol1.Item(i)
sB.SetPosition sA.PositionX, sA.PositionY + (sA.SizeHeight / 2) +
(sB.SizeHeight / 2) + 0.15
End If
End Function
You are setting the objects equal to each other and they reference each other in memory. In fact, you are doubling the object and using up twice as much memory.
Set sets an object equal to the reference of the object you want it to be. Here is an example.
Public Sub test()
Dim s As Worksheet
Dim s2 As Worksheet
Set s = Application.Workbooks.Add().Worksheets.Add
s.Name = "one"
Set s2 = s 's and s2 Name = "one"
s.Name = "two" 's and s2 Name = "two"
End Sub
Let sets an object equal to the value of the object you want it to be.
Try
Set sA = new Shape
Let sA = sB
Instead of
Set sA = sB
If that doesn't work, you may have to create a property or variable for each of the shapes you are wanting to work with.
Similar Question

How do I add to this array?

I have an object called pushOrderIncQTY. I can insert one item into the array using the I have an overload which accepts multiple items. My question is: how do I resize the array and add a record to it?
Dim pushOrderIncQTY() As infoPushOrderIncQTY
With pushOrderIncQTY
.costPrice = thisentry.Item("costPrice")
.externalTimeStamp = DateTime.Now()
.RootPLU = thisentry.Item("tagbarcode") 'set this to the barcode from the file
.sizeBit = -666
.supplierID = cfb.SupplierID
.orderReference = thisentry.Item("OrderNumber")
.orderLineReference = ""
.externalTransaction = ""
.sourceShop = cfb.SiteId 'set to the GEMINI location ID for this store (you will have to get this from your configuration file
.destinationShop = cfb.SiteId 'set this to the same as the sourceshop
.QTY = thisentry.Item("ActQty")
.whichQty = LiveSales.infoPushOrderIncQTY.Which_OrderQty.delivered 'only available option at present
End With
Edits here
Ok So i Can go with a list I tested this code and its putting int 16 records fine but how do I get it to go in batches
Dim pushOrderInQty As New List(Of infoPushOrderIncQTY)()
For Each thisentry2 In orderLineData.Rows
With pushOrderIncQTY
.costPrice = thisentry2.Item("costPrice")
.externalTimeStamp = DateTime.Now()
.RootPLU = thisentry2.Item("tagbarcode") 'set this to the barcode from the file
.sizeBit = -666
.supplierID = cfb.SupplierID
.orderReference = thisentry2.Item("OrderNumber")
.orderLineReference = ""
.externalTransaction = ""
.sourceShop = cfb.SiteId 'set to the GEMINI location ID for this store (you will have to get this from your configuration file
.destinationShop = cfb.SiteId 'set this to the same as the sourceshop
.QTY = thisentry2.Item("ActQty")
.whichQty = LiveSales.infoPushOrderIncQTY.Which_OrderQty.delivered 'only available option at present
End With
recordCount = recordCount + 1
pushOrderInQty.Add(pushOrderIncQTY)
Next
CallWebSerivce(wrpPush, request, pushOrderInQty.ToArray())
What I want is the ability to set batch size in cfb.batchsize which is a wrapper for my config file, what I want is say if their is 20 records and batch size is 5 it means the web service should be only called 4 times and not 20 individual times? and the records that get added to list is only 5 till the records set is completed?
You have asked two questions. So here is a separate answer to your second question. You simply need to count the reps within your loop. When you hit your batch size, call your web service and empty your list (to start over with a fresh batch). Like this:
Dim pushOrderInQty As New List(Of infoPushOrderIncQTY)()
For Each thisentry2 In orderLineData.Rows
With pushOrderIncQTY
.costPrice = thisentry2.Item("costPrice")
.externalTimeStamp = DateTime.Now()
'...etc
End With
recordCount = recordCount + 1
pushOrderInQty.Add(pushOrderIncQTY)
If recordCount >= cfb.BatchSize Then
CallWebSerivce(wrpPush, request, pushOrderInQty.ToArray())
pushOrderInQty.Clear()
recordCount = 0
End If
Next
'get the last, partial batch
If pushOrderInQty.Count > 0 Then
CallWebSerivce(wrpPush, request, pushOrderInQty.ToArray())
End If
You can use ReDim to resize any arry, but it wipes the contents. ReDim Preserve will retain the contents.
ReDim Preserve pushOrderIncQTY(5)
'or just make it one element larger, which is something you DO NOT want to do in a loop
Dim oldSize as integer = UBound(pushOrderIncQTY)
ReDim Preserve pushOrderIncQTY(oldSize + 1)
Btw, you could also define it as type List(of pushOrderIncQTY) and then after the list is loaded, you could use the .ToArray() method to convert it to an array.

VB2010: Export datagrid to Excel only retieving one row

I just want to mention first, I do appreciate everyone who gives of their knowledge to help others learn...
I have been able to piece together code that exports my Datgrid to an Excel file and works fine, except I am only getting the first row of the datagrid. since the datagrid could contain one record, or hundreds, I need all rows to export to Excel.
Here is what I have been able to put together (again, it works fine, file is saved with column headers, but only writes the first row of data from my datagrid):
'Export to Excel
Dim ExApp1 As Excel.Application
Dim ExWkbk1 As Excel.Workbook
Dim ExWksht1 As Excel.Worksheet
Dim MisValue As Object = System.Reflection.Missing.Value
Dim i As Integer
Dim j As Integer
ExApp1 = New Excel.Application
ExWkbk1 = ExApp1.Workbooks.Add(MisValue)
ExWksht1 = ExWkbk1.Sheets("sheet1")
For i = 0 To dg7.RowCount - 2
For j = 0 To dg7.ColumnCount - 1
ExWksht1.Cells(i + 2, j + 1) = dg7(j, i).Value.ToString()
For k As Integer = 1 To dg7.Columns.Count
ExWksht1.Cells(1, k) = dg7.Columns(k - 1).HeaderText
ExWksht1.Cells(i + 2, j + 1) = dg7(j, i).Value.ToString()
Next
Next
Next
ExWksht1.SaveAs("C:\MyExcel.xlsx")
ExWkbk1.Close()
ExApp1.Quit()
releaseObject(ExApp1)
releaseObject(ExWkbk1)
releaseObject(ExWksht1)
Again, many thsanks in advance for helping me learn
First of all it seems to me this is a DataGridView as opposed to a DataGrid since from what I know DataGrid does not have "RowCount" or "ColumnCount" properties in either WinForms or Web.UI (I could be wrong).
If it is so is there a specific reason for
dg7.RowCount - 2
If the object you are trying to get data from is indeed a DataGridView then I suppose this task is to omit new(empty) rows. If I am correct that you are trying to export data from a DataGridView this way there is a property for the DataGridViewRow that will serve this purpose:
IsNewRow
So (while I have not used Excel in VB.NET recently) your cycle could be:
For i = 0 To dg7.ColumnCount - 1
ExWksht1Cells(1 , i + 1) = dg7.Columns[i].HeaderText
Next
For i = 0 To dg7.RowCount - 1
If Not dg7.Rows(i).IsNewRow Then
For j = 0 To dg7.ColumnCount - 1
ExWksht1.Cells(i+ 2, j + 1) = dg7(i, j).Value.ToString()
Next
End If
Next
As far as the excel object calls I can't give a reasonable comment since I've not used that object too much.Let me know if that's useful and/or correct.