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
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.
very simple Problem:
Dim myForm As Object
Set myForm = ThisWorkbook.VBProject.VBComponents.Add(3)
Set MyComboBox = myForm.Designer.Controls.Add("Forms.ComboBox.1")
With MyComboBox
.Left = 100
.Top = 20 + x * 10
.Height = 16
.Width = 100
For Each col In fields
.AddItem col
Next
End With
I can clearly print out the values in fields (which is a variant), but somehow the Combobox remains blank... Any ideas? I'm wasting way to much time on this...
thanks for your help
Is there a way to change the index value of a ActiveX Button that inserted onto a spreadsheet. I currently have four buttons and two are hidden and two are visible. I would like to re-order the them to not have a large gap between objects. I have some VBA code that runs when the document is opened to ensure that they are the right size and location. Because it loops through the OLEObjects Collection; it will not matter what order they are in on the spreadsheet they will always appear with a gap because of the index value in the OLE Object collection. Below is the code:
Private Sub Workbook_Open()
Application.ErrorCheckingOptions.EvaluateToError = False
ActiveWorkbook.Worksheets("SITE").Activate
Dim button As OLEObject
Dim name As String, top As Integer
top = 15
For Each button In ActiveWorkbook.Worksheets("SITE").OLEObjects
Debug.Print button.name & " " & button.ZOrder
name = button.name
If button.OLEType = xlButtonOnly And InStr(name, "btn") = 1 Then
With button
.Height = 21.75
.Width = 174.75
.Left = 1114.5
.top = top
End With
top = top + 30
End If
Next button
End Sub
If you give them proper names with an integer code in it reflecting their intended position (e.g.: "btn...01", "btn...02",...) then you could try this code (sorry for not being able to format it as code by now):
Private Sub Workbook_Open()
Application.ErrorCheckingOptions.EvaluateToError = False
ActiveWorkbook.Worksheets("SITE").Activate
Dim button As OLEObject
Dim name As String
Dim btnRnk As Long
For Each button In ActiveWorkbook.Worksheets("SITE").OLEObjects
name = button.name
If button.OLEType = xlButtonOnly And InStr(name, "btn") = 1 Then
btnRnk = CLng(Right(name,2))
With button
.Height = 21.75
.Width = 174.75
.Left = 1114.5
.top = 15 + (btnRank - 1) * 30
End With
End If
Next button
End Sub
I am using a spin button to cycle through dates of a phase. When I call an item from a collection called customtextboxcollection with its index value, I get an "Object Required" error. Both the spin button and the text box whose value changes are dynamically created controls displayed on a UserForm called UserForm1.
The sub to create the items in customtextbox collection run before the spin button is clicked:
Dim customtextboxcollection As Collection
Dim spinbuttoncollection As Collection
Public Sub ComboBox1_Click() 'When a person is selected to enter hours for an employee from a combobox, it triggers the creation of the controls
Sheet1.Activate
CommandButton1.Enabled = True 'Enable the OK and Apply buttons when personnel title is selected.
UserForm1.Label2.Visible = True
UserForm1.ratebox.Visible = True
QuantityLabel.Visible = True
quantitybox.Visible = True
'The variables below are to access the table where I store saved information regarding the project phases I will add hours to.
Dim counter As Integer
counter = 6 'The index of the first row for phases
Dim phasecolumn As Integer
phasecolumn = 3 'The index of the column containing the phases
Dim checkboxnumber As Integer
checkboxnumber = 1 'This is the number needed to distinguish between the checkboxes that appear/disappear.
phasestartcolumn = 4
phaseendcolumn = 5
Dim customtextboxHandler As cCustomTextBoxHandler
Set customtextboxcollection = New Collection 'Sets the previously created collection
Dim spinbuttonHandler As cSpinButtonHandler 'This is my spin button handler class
Set spinbuttoncollection = New Collection 'Sets the previously created collection
'This Do-Loop locates a row on the table with saved information
Do
If (Sheet3.Cells(savedpersonnelrow, savedpersonnelcolumn) = ComboBox1.Value) Then
storagerow = savedpersonnelrow
lastcomboboxvalue = ComboBox1.Value
Exit Do
End If
savedpersonnelrow = savedpersonnelrow + 1
Loop Until (savedpersonnelrow = 82)
Sheet1.Activate
'These sections create the controls depending on the number of phases saved.
Set spin = UserForm1.Controls.Add("Forms.SpinButton.1")
With spin
.name = "SpinButton" & checkboxnumber
.Left = 365
.Top = topvalue + 6
.Height = 15
.Width = 40
'.Value = Sheet3.Cells(storagerow, savedphasecolumn + checkboxnumber)
'Sheet1.Activate
Dim phasestart As Date
phasestart = Sheet1.Cells(counter, phasestartcolumn).Value
Dim phaseend As Date
phaseend = Sheet1.Cells(counter, phaseendcolumn).Value
spin.Min = phasestart
spin.Max = phaseend
spin.Orientation = fmOrientationVertical
'Do
'.AddItem Format(phasestart, "mmm-yy")
'phasestart = DateAdd("m", 1, phasestart)
'Loop Until (Month(phaseend) = Month(phasestart) And Year(phaseend) = Year(phasestart))
Set spinbuttonHandler = New cSpinButtonHandler
Set spinbuttonHandler.spin = spin
spinbuttoncollection.Add spinbuttonHandler
End With
Set ctext = UserForm1.Controls.Add("Forms.TextBox.1")
With ctext
.name = "CustomTextbox" & checkboxnumber
.Left = 470
.Top = topvalue + 6
.Height = 15
.Width = 40
.Value = phasestart
Set customtextboxHandler = New cCustomTextBoxHandler
Set customtextboxHandler.ctext = ctext
customtextboxcollection.Add customtextboxHandler
End With
topvalue = topvalue + 15
counter = counter + 1
checkboxnumber = checkboxnumber + 1
Loop Until counter = 14
End Sub
In my class called cSpinButtonHandler, I reference these customtextboxcollection object associated with it's corresponding spin button:
Public WithEvents spin As MSForms.SpinButton
Private Sub spin_Click()
UserForm1.CommandButton3.Enabled = True
End Sub
Private Sub spin_SpinDown()
x = 0
Do
x = x + 1
Loop Until spin.name = "SpinButton" & x
Dim spindate As Date
spindate = customtextboxcollection.Item(x).ctext.Value 'The error occurs here.
customtextboxcollection.Item(x).ctext.Value = DateAdd("m", -1, spindate)
End Sub
Why is this reference generating an error? What is the correct way to reference it?
This is not an answer to your real question, but a suggestion for an alternate approach which might be easier to manage.
Instead of using two separate collections and two different classes, you could create a single class which would handle each pair of controls (one spin and one text box). That would be easier to handle in terms of hooking events between each pair.
clsSpinText:
Option Explicit
Public WithEvents txtbox As MSForms.TextBox
Public WithEvents spinbutn As MSForms.SpinButton
Private Sub spinbutn_Change()
'here you can refer directly to "txtbox"
End Sub
Private Sub txtbox_Change()
'here you can refer directly to "spinbutn"
End Sub
When adding your controls create one instance of clsSpinText per pair, and hold those instances in a single collection.
I have an excel UserForm that creates textboxes during execution time. code as follows;
Dim CompHandler() As New CCompHandler
Dim tb As MSForms.TextBox
Dim count As Integer
For i in Range(something)
If i = anotherthing Then
Set tb = UserForm1.Controls.Add("Forms.TextBox.1", "tb" & count)
With tb
.Width = iTbWidth
.Top = count * distance
.Left = iTbLeft
.Height = iTbHeight
.Value = Cells(row, column)
ReDim Preserve CompHandler(0 To count)
Set CompHandler(count).TextBoxGroup = tb
End With
count = count + 1
End If
Next i
I want to write back the changed value to the corresponding cell.
I'm already able to get when the box has changed and the new value with this code on a class called CCompHandler:
Option Explicit
Public WithEvents TextBoxGroup As MSForms.TextBox
Private Sub TextBoxGroup_Change()
MsgBox TextBoxGroup
End Sub
So.. any ideas on how can I get which textbox has changed?
Or maybe is there a better way of doing that?
Thanks in advance
The Tag property is typically used for something like this. On creation add something like:
With tb
...
.Tag = i.Address
...
End With
You can then access the Tag property later, with something like:
Debug.Print tbWhoseValueHasChanged.Tag
Your code snippet has a lot of undefined/unclear variables, including i. I assumed it was a range variable in the above.