I am working on a Userform in which one can add and remove Textboxes. These TextBoxes then can be filled out and by using a CommandButton SaveData the content should then safe in the sheet.
In order to do so, I declared a gloabal variable nFarbe. Using this variable I am controlling the number of Texboxes. The weird thing is, by initialising the Form calling LoadTextBox and ReadTextBoxContent the correct number of boxes are loaded and the content is filled in. Howevern, by adding a TextBox AddColor the nFarbe is increased by 1 in Order to add a TextBox. The additional TextBox shows up, but the content of all boxes but the new one vanishes. This I do not understand since I'm calling LoadTextBox and ReadTextBoxContent as I do during the initialization. By calling RemoveColor nFarbeis reduced by 1 in order to delete 1 TextBox. This does not work at all.
Any thouhts? Help is much appreciated!
Private Sub Userform_Initialize()
nFarbe = 1
Call LoadTextBox
Call ReadTextBoxContent
End Sub
Private Sub AddColor_Click()
nFarbe = nFarbe + 1
Call LoadTextBox
Call ReadTextBoxContent
TextBox_nFarbe = nFarbe
End Sub
Private Sub RemoveColor_Click()
nFarbe = nFarbe - 1
Call LoadTextBox
Call ReadTextBoxContent
TextBox_nFarbe = nFarbe
End Sub
Private Sub SaveData_Click()
Dim z As Double
z = 0
For i = 1 To nFarbe
z = 31 + i
Cells(z, 1).Value = Me("ProductColor" & i).Text
Next i
End Sub
Sub LoadTextBox()
Dim NewColorTextbox As Variant
Dim tp As Double
tp = 25
For i = 1 To nFarbe
Set NewColorTextbox = Me.Controls.Add("Forms.TextBox.1", "MyTextBox", True)
With NewColorTextbox
.Name = "ProductColor" & i
.Width = 150
.Height = 18
.Top = tp
.Left = 30
.ZOrder (0)
.Font.Size = 10
End With
tp = tp + 25
Next i
End Sub
Sub ReadTextBoxContent()
Dim z As Double
For i = 1 To nFarbe
z = 31 + i
Me("ProductColor" & i) = Cells(z, 1)
Next i
End Sub
Related
I have a Data Entry Userform that works but now I want to replicate it I need 36 fields in total (144 items not including buttons)
for an example
Field 1 will consist of a TextBox and 3 labels. (Data Entry, Title, Bottom Border and FieldRequired label.
What I want to do is to generate the above with names like Txt1,Txt2,Txt3.... Title1, Title2, Title3, Bdr1,Bdr2,Bdr3, Fr1,Fr2,Fr3 and for some I need to create Listbox1,Listbox2 and Listbox3 inside of frames 1 2 and 3 but this I can do manually.
I want to separate them so 4 fields across and 9 fields down.
Is there an easy solution to doing this or just doing it manually?
I can sort of do this using the below and then just doing this 4 times and adding 80 to the left
I would then need do to the same for the other fields and apply the events to them and fonts/font sizes etc but I cant figure out how to use events against them.
Sub addLabel()
frmUserAdd.Show vbModeless
Dim lblid As Object
Dim lblc As Long
For lblc = 1 To 9
Set lblid = frmUserAdd.Controls.Add("Forms.Label.1", "Alert" & lblc, True)
With lblid
.Caption = "*Field Required" & lblc
.Left = 10
.Width = 60
.Top = 30 * lblc
End With
Next
end sub
Please, test the next scenario:
Insert a class module, name it "clsTbox" and copy the next code inside it:
Option Explicit
Public WithEvents newTBox As MSForms.TextBox
Private Sub newTBox_Change()
If Len(newTBox.Text) > 3 Then 'it do something for 4 entered digits:
Select Case CLng(Right(newTBox.name, 1))
Case 1, 3
MsgBox newTBox.name & " changed (" & newTBox.Text & ")"
Case 2, 4
MsgBox newTBox.name & " changed its text"
Case Else
MsgBox newTBox.name & " Different text..."
End Select
End If
End Sub
Insert a Userform and copy the next code in its code module:
Option Explicit
Private TBox() As New clsTBox
Private Sub UserForm_Initialize()
Dim i As Long, txtBox01 As MSForms.TextBox, leftX As Double, tWidth As Double, k As Long
Const txtBName As String = "Txt"
leftX = 20: tWidth = 50
ReDim TBox(10) 'use here the maximum number of text boxes you intend creating
For i = 1 To 5
Set txtBox01 = Me.Controls.Add("Forms.TextBox.1", txtBName & i)
With txtBox01
.top = 10
.left = leftX: leftX = leftX + tWidth
.width = tWidth
.Text = "something" & i
End With
Set TBox(k).newTBox = txtBox01: k = k + 1
Next i
ReDim Preserve TBox(k - 1) 'keep only the loaded array elements
End Sub
Now, show the form and play with text in the 5 newly created text boxes.
You can show one of its instances in the next way:
a) Name it "frmTxtBEvents"
b) Use the next Sub:
Sub ShowTheForm()
Dim frm As New frmTxtBEvents
frm.Show vbModeless
End Sub
When enter 4 characters, according to the last text box name digit their Change event will show specific message boxes...
If something not clear enough, do not hesitate to ask for clarifications.
But it is late in my country and (today) I will be available for no more than half an hour.
I am trying to add _Change() event to dynamically created TextBox using classes in VBA. However there is nothing happening, when I try to run my code. Could you please point me where I am wrong?
I have got class conditionEventClass
Public WithEvents conditionEvent As MSForms.textBox
Public Property Let textBox(boxValue As MSForms.textBox)
Set conditionEvent = boxValue
End Property
Public Sub conditionEvent_Change()
MsgBox conditionEvent.Name & " changed."
End Sub
I have got following code in my module:
Sub addConditions()
Dim conditionCommand As conditionEventClass
Dim newTextBox As MSForms.textBox
Set newTextBox = commandRequestForm.MultiPage1(1).Controls.Add("Forms.TextBox.1", "conditionValue", True)
With newTextBox
.Name = "conditionValue"
.Left = 750
.height = 15
.Width = 100
.Top = 20
End With
Set conditionCommand = New conditionEventClass
conditionCommand.textBox = newTextBox
End Sub
I expect that my sub conditionEvent_Change() is going to show msgBox. But unfortunately nothing happens.
Talking about only a single Text Box, you can use the next simpler way:
1.Declare a private variable on top of the form code module (in the declarations area):
Private WithEvents myTextBox As MSForms.TextBox
Then, create the event for the above declared variable:
Private Sub myTextBox_Change()
MsgBox activecontrol.name & " changed."
End Sub
Use your adapted code as:
Sub addConditions()
Dim newTextBox As MSForms.TextBox
Set newTextBox = commandRequestForm.MultiPage1(1).Controls.Add("Forms.TextBox.1", "myTextBox", True)
With newTextBox
.left = 10
.height = 15
.width = 100
.top = 20
End With
Set myTextBox = newTextBox
End Sub
For 1 to 3, 4 such controls you can use the simpler (above shown) way. If you need creating on the fly a lot of such controls, I can show you how to adapt your code...
Edited:
Please, use the next working way using a class to be assigned to many text boxes created on the fly:
Copy the next code in a class module and name it 'clsTBox':
Option Explicit
Public WithEvents newTBox As MSForms.TextBox
Private Sub newTBox_Change()
MsgBox newTBox.name & " changed."
End Sub
2.Declare a Private variable on top of the form code module:
Private TBox() As New clsTBox
Use the next Sub to create three text boxes and assign the Click event to them:
Private Sub CreateThreeTB()
Dim i As Long, txtBox01 As MSForms.TextBox, leftX As Double, tWidth As Double, k As Long
leftX = 20: tWidth = 50
ReDim TBox(100) 'use here the maximum number of text boxes you intend creating
For i = 1 To 3
Set txtBox01 = Me.Controls.Add("Forms.TextBox.1", "dynTxtBox_" & i)
With txtBox01
.top = 10
.left = leftX: leftX = leftX + tWidth
.width = tWidth
.Text = "something" & i
End With
Set TBox(k).newTBox = txtBox01: k = k + 1
Next i
ReDim Preserve TBox(k - 1)
End Sub
Call the above Sub from Initialize event or from another control, play with the newly created text boxes value and see how the change event is triggered...
I create a form dynamically and fill it with check boxes generated based on all column names of the Excel sheet it is launched from.
I add also a command button.
Here is the code put directly on the form:
Option Explicit
Dim cmdArray() As New Class1
Private Sub UserForm_Initialize()
Dim lastCol As Integer
Dim i As Integer
Dim chkBox As MSForms.CheckBox
Dim myButton As Control
lastCol = Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
Me.Height = 500
Me.Width = 600
For i = 1 To lastCol
Set chkBox = Me.Controls.Add("Forms.CheckBox.1", i)
chkBox.Caption = Worksheets(1).Cells(1, i).Value
' chkBox.Name = i
If i Mod 2 = 1 Then
chkBox.Left = 5
chkBox.Top = 5 + (i - 1) * 10
chkBox.Width = 200
Else
chkBox.Left = 250
chkBox.Top = 5 + (i - 2) * 10
chkBox.Width = 200
End If
Next i
i = 1
Set myButton = Me.Controls.Add("Forms.CommandButton.1", "MyButton", False)
With myButton
.Left = 500
.Top = chkBox.Top - 50
.Width = 50
.Caption = "Hide"
.Visible = True
End With
ReDim Preserve cmdArray(1 To i)
Set cmdArray(i).CmdEvents = myButton
Set myButton = Nothing
Me.ScrollBars = fmScrollBarsVertical
Me.ScrollHeight = chkBox.Top + 20
End Sub
The form is generated without issue: all check-boxes and the command button are set correctly.
I am then supposed to select which columns I want to hide from my Excel sheet, and therefore I tick the relevant checkbox. So far so good. Here is the code set is a Class :
Option Explicit
Public WithEvents CmdEvents As MSForms.CommandButton
Private Sub CmdEvents_Click()
Dim i As Integer
Dim cbx As MSForms.Control
Dim colNum As Integer
i = 0
For Each cbx In Me.UserForm1.Controls
If TypeName(cbx) = "CheckBox" Then
If cbx.Value = True Then
colNum = cbx.Name - i
Worksheets(1).Columns(colNum).EntireColumn.Delete
i = i + 1
End If
End If
Next ctrl
End Sub
When I click the button, it is supposed to trigger the hiding of the columns in the Excel sheet, however, I got the following error:
Compile error: Method or data member not found
This error is reported in the code in the Class module, highlighting the term .UserForm1 and if I remove this .UserForm1, then still the same error highlighting the .Controls.
I am not a great specialist of VBA, I manage usually to create simple codes and reusing samples I can find here and there, but this time, I run out of idea (and understanding), so thanks in advance for any help.
I have a userform with multiple dependent Comboboxes. I would like to add the following code to 10 of the Comboboxes Change event. The Comboboxes to be coded are Numbered 11 to 20 (Combobox11, Combobox 12, etc) while the dependent Comboboxes are numbered 21 to 30.
I could copy and paste the code 10 times and then find and replace the relevant Combobox Nos.
Is there a way to use a loop through the Combo-Boxes to achieve this?
Any assistance would be most grateful.
Private Sub ComboBox11_Change()
Dim index As Integer
index = ComboBox11.ListIndex
ComboBox21.Clear
Select Case index
Case Is = 0
With ComboBox21
.RowSource = Range("SubCat1").Address(external:=True)
End With
Case Is = 1
With ComboBox21
.RowSource = Range("SubCat6").Address(external:=True)
End With
Case Is = 2
With ComboBox21
.RowSource = Range("SubCat7").Address(external:=True)
End With
Case Is = 3
With ComboBox21
.RowSource = Range("SubCat8").Address(external:=True)
End With
Case Is = 4
With ComboBox21
.RowSource = Range("SubCat9").Address(external:=True)
End With
'and several more case options
End Select
End Sub
You can use a Class Module, and a User_Init Sub to set each ComboBox control in the user form to this class.
In my code I used Main_Form as the name of the User_Form, modify the code according to your User_Form Name.
Add a Calls Module, and add this code below in Class 1:
Public WithEvents ComboBoxEvents As MSForms.ComboBox
' anytime a Change event occurs to any ComboBox, the Sub is triggered
Private Sub ComboBoxEvents_Change()
Dim ComboBox_Index As String
Dim index As Integer
With ComboBoxEvents
' read the index of the ComboBox, as long as the names remain ComboBox1, ComboBox2, ComboBox3, etc...
ComboBox_Index = Mid(.Name, 9)
' run this code if it's ComboBox 11 to 20
If ComboBox_Index >= 11 And ComboBox_Index <= 20 Then
index = .ListIndex
Select Case index
Case Is = 0
With Main_Form.Controls("ComboBox" & ComboBox_Index + 10)
.RowSource = Range("SubCat1").Address(external:=True)
End With
Case Is = 1
With Main_Form.Controls("ComboBox" & ComboBox_Index + 10)
.RowSource = Range("SubCat6").Address(external:=True)
End With
Case Is = 2
With Main_Form.Controls("ComboBox" & ComboBox_Index + 10)
.RowSource = Range("SubCat7").Address(external:=True)
End With
Case Is = 3
With Main_Form.Controls("ComboBox" & ComboBox_Index + 10)
.RowSource = Range("SubCat8").Address(external:=True)
End With
Case Is = 4
With Main_Form.Controls("ComboBox" & ComboBox_Index + 10)
.RowSource = Range("SubCat9").Address(external:=True)
End With
'and several more case options
End Select
End If
End With
End Sub
The code below goes in your User_Form_Init (in my code the name of the User_Form is Main-Form) :
Option Explicit
Dim ComboBoxes() As New Class1
Private Sub UserForm_Initialize()
Dim ComboBoxCounter As Integer, Obj As Control
For Each Obj In Me.Controls
If TypeOf Obj Is MSForms.ComboBox Then
ComboBoxCounter = ComboBoxCounter + 1
ReDim Preserve ComboBoxes(1 To ComboBoxCounter)
Set ComboBoxes(ComboBoxCounter).ComboBoxEvents = Obj
End If
Next Obj
Set Obj = Nothing
End Sub
the way is using Class
add a Class module and name it after "CmbBox" (you can choose whatever name but be consistent with it)
add the following code into the class code pane:
Option Explicit
Public WithEvents Cmb As MSForms.ComboBox
Private Sub Cmb_Change()
Dim index As Long
With Cmb
index = .ListIndex
With .Parent.Controls("ComboBox" & Mid(.Name, 9) + 10)
.Clear
Select Case index
Case 0
.RowSource = Range("SubCat1").Address(external:=True)
Case 1 To 4
.RowSource = Range("SubCat" & index + 5).Address(external:=True)
End Select
End With
End With
End Sub
Then switch to your userfom code pane and add this code:
Dim Cmbs(1 To 10) As New CmbBox '<--| this must be at the very top of your userform code pane
Sub Userform_Initialize()
Dim i As Long
With Me.Controls
For i = 11 To 20
Set Cmbs(i - 10).Cmb = .Item("ComboBox" & i)
Next i
End With
End Sub
and that's it
Private Sub ScrollBar1_Change()
ActiveWindow.Zoom = ScrollBar1.Value
End Sub
Private Sub UserForm1_Initialize()
With ScrollBar1
.Min = 10
.Max = 400
.SmallChange = 1
.LargeChange = 10
End With
End Sub
I used the above code but get this run time error:
error 1004(unable to set the zoom property of the window class)
Move the code to the Activate event instead of the Initialize event so that it updates the initial value properly. The error is because the initial value is still 1 otherwise, and you can't zoom below 10%.
This is due to the the zoom needing to be above 10. Do something like this.
Private Sub ScrollBar1_Change()
Dim i As Integer
i = ScrollBar1.Value
If i <= 10 Then
i = 10
End If
ActiveWindow.Zoom = i
End Sub
You could also post this part:
With ScrollBar1
.Min = 10
.Max = 400
.SmallChange = 1
.LargeChange = 10
End With
In the same block as:
ActiveWindow.Zoom = ScrollBar1.Value
So it looks like this:
Private Sub ScrollBar1_Change()
ActiveWindow.Zoom = ScrollBar1.Value
With ScrollBar1
.Min = 10
.Max = 400
.SmallChange = 1
.LargeChange = 10
End With
End Sub