Create and manipulate On-demand collections of runtime controls - vba

Question

This is my first post. I've tried to find a similar topic but could not find any.
I am fairly new to VBA and I am learning as I try to create a file that helps plan cutting parts of a major piece.
Since Excel VBA does not allow to draw shapes or lines, I am using labels with a border to create rectangles.
The rectangles represent the cuts to be made.
My main form has this look:
Main Form
As you can see in the image, in the area signaled with a red rectangle, the big piece with 1600 mm (in this example) will have seven 60 mm cuts.
My problem started when I tried to add different cuts to my cutting planning.
As I accept a cut, it goes to the cutting queue, and a new cut can be defined, as shown in the below image:
Second cut
The problem is that the first cut should stay there. I realized that I have to use Collections and most probably Classes for that.
This is especially important as I want, in the queue, to be able to move each line up and down the queue or even erase a line (and reflect it in my "drawing").
The code for now is far too extensive to add it here, but I managed to put some in functions that will go bellow. Some names are in portuguese, but I don't think it presents a problem.
Here I create the cuts defined by Largura: and Cortes reais:
Option Explicit
Public iCuts As Integer
Public Labels As Collection
Public newLabel As Object
Public bRecalculate As Boolean
Sub DrawCuts(NCuts As Integer, CutWidth As Double, TotalWidth)
Dim OriginX, OriginY As Integer
Dim labelCounter As Long
Dim labelCollection As New Collection
OriginX = 372
OriginY = 24
CutWidth = Multiplier(CutWidth, TotalWidth)
For labelCounter = 0 To NCuts - 1
Set newLabel = frmPlanning.Controls.Add("Forms.Label.1", "Corte" & labelCounter, True)
With newLabel
.ControlTipText = .Name 'labelCounter + 1
.Left = OriginX + CutWidth * labelCounter
.Width = CutWidth
.Height = 48
.Top = OriginY
.BackColor = &HFFFFFF
.BorderStyle = 1
.TextAlign = 2
.Font.Size = 6
.Caption = iCuts
End With
iCuts = iCuts + 1
Next
iCuts = iCuts - 1
End Sub
And in the next SUB I adapt the cuts to the size of the main piece, defined by Larg. bobine:
Sub Dim_Labels(Cuts As Integer, CutWidth As Double, RollWidth As Double, RollLeft As Double)
With frmPlanning.lCutWidth
.Caption = CutWidth * Cuts
.Width = Cuts * Multiplier(CutWidth, RollWidth)
End With
With frmPlanning.lCutLeft
.Caption = RollLeft
.Left = 372 + Cuts * Multiplier(CutWidth, RollWidth)
.Width = 320 - Cuts * Multiplier(CutWidth, RollWidth)
End With
frmPlanning.lRollWidth = RollWidth
End Sub
I have tried to put this in a collection but not only I receive all sorts of errors but I also cannot create different collections for each set of cuts on order to move each set independently.
I know this has to due with my lack of understanding of how collections and classes work, but I really am stuck and cannot go forward with this and need some help if you can give it.
I couldn't find a way, but I can provide the excel file to help you better understand the problem, if there is a way.
Thank you.
Júlio

Answer 1

So, I think this is what you're after. Note that it's not the cleanest code, but it does the drawing bits on a userform in isolation.
First, I stored the OriginX and OriginY in the Userform itself - After all, it should control where the drawing should start. Userform code:
Public OriginX As Integer
Public OriginY As Integer
Private Sub UserForm_Initialize()
OriginX = 20
OriginY = 20
End Sub
Next, I created a class "BigBox" for the red rectangle you had. It has a Height, a Width, and on initialization it will add it's label to the Userform.
(Note that putting the label on the form in this way is bad practice - The class shouldn't have to be aware of where to draw it. However - for answering your question this isn't immediately relevant.)
BigBox Class:
Private p_width As Integer
Private p_height As Integer
Private p_label As MSForms.Label
Public Property Let Width(value As Integer)
p_width = value
p_label.Width = p_width
End Property
Public Property Get Width() As Integer
Width = p_width
End Property
Public Property Let Height(value As Integer)
p_height = value
p_label.Height = p_height
End Property
Public Property Get Height() As Integer
Height = p_height
End Property
Public Property Get Label() As MSForms.Label
Set Label = p_label
End Property
Private Sub Class_Initialize() 'This bit is bad practice, but it works:
Set p_label = frmPlanning.Controls.Add("Forms.Label.1", "BigBox", True)
p_label.Left = frmPlanning.OriginX
p_label.Top = frmPlanning.OriginY
p_label.BorderColor = Red
p_label.BorderStyle = 1
End Sub
Next, I created a class "Cut" that can be used in a collection with the cuts, so when you need to redraw, you have them stored / they don't get forgotten:
Cut class:
Private p_width As Integer
Private p_height As Integer
Public Property Let Width(value As Integer)
p_width = value
End Property
Public Property Get Width() As Integer
Width = p_width
End Property
Public Property Let Height(value As Integer)
p_height = value
End Property
Public Property Get Height() As Integer
Height = p_height
End Property
Next, I isolated the "Cuts" and the "Labels" collections, since the labels need to be deleted and redrawn when you add a second batch. The following routine
Makes sure the Cuts collection and the labels collections exist
Shows the form (modeless, so code execution continues)
Creates the BigBox and sets the height and width. All cuts will take the height from here.
Adds cuts a couple of times.
Has the "add cut" routine also execute the drawing routine.
Module1 code:
Option Explicit
Public bb As BigBox
Public cuts As Collection
Public cutLabels As Collection
Public totalCutsWidth As Integer
Public piece As Cut
Sub test2()
If cuts Is Nothing Then
Set cuts = New Collection
End If
If cutLabels Is Nothing Then
Set cutLabels = New Collection
End If
frmPlanning.Show vbModeless
Set bb = New BigBox
bb.Height = 100
bb.Width = 500
AddCuts 5, 20
AddCuts 10, 10
AddCuts 7, 50
End Sub
Sub AddCuts(numberOfCuts As Integer, widthOfCuts As Integer)
Dim i As Integer
If numberOfCuts <= 0 Then Exit Sub
For i = 1 To numberOfCuts
Set piece = New Cut
piece.Width = widthOfCuts
piece.Height = bb.Height
totalCutsWidth = totalCutsWidth + widthOfCuts
If totalCutsWidth <= bb.Width Then
cuts.Add piece
End If
Next i
DrawCuts
End Sub
Sub DrawCuts()
Dim i As Integer
Dim OffsetX As Integer
Dim newLabel As MSForms.Label
OffsetX = 0
For i = cutLabels.Count To 1 Step -1
frmPlanning.Controls.Remove "Corte" & i
cutLabels.Remove i
Next i
i = 0
OffsetX = frmPlanning.OriginX
For Each piece In cuts
i = i + 1
Set newLabel = frmPlanning.Controls.Add("Forms.Label.1", "Corte" & i, True)
With newLabel
.ControlTipText = .Name
.Left = OffsetX
.Width = piece.Width
.Height = piece.Height
.Top = frmPlanning.OriginY
.BackColor = &HFFFFFF
.BorderStyle = 1
.TextAlign = 2
.Font.Size = 6
.Caption = i
OffsetX = OffsetX + piece.Width
End With
cutLabels.Add newLabel
Next piece
End Sub
Note that add cuts makes sure that the cuts still fit within the big box, and that the drawing of the cuts is separated from that. Also, if the next piece wouldn't fit in the box anymore it won't be added. I.e. if the big box has width 500, and you add 10 cuts of width 25, and then 11 cuts of width 30, it will only add the first 8 of the second batch (10*25=250, 8*30=240, 240+250=490, so the 9th, 10th and 11th do not fit in the 500 total width, therefore will not be added.
Hope this helps and is enough information to merge into your existing solution.