Please i need your help, i have a problem with the next code, i want to write in different cells all the values that user enters, in the Private Sub CommandButton1_Click() i only write 3 of them, but i can´t do that even the fist value appears, only appears an error:
object doesn´t support this property or method.
Dim Label1 As Object
Dim txtB1 As Control
For NL = 1 To NumeroLineas
Set txtB1 = UserForm2.Controls.Add("Forms.TextBox.1", "TxtBx" & NL, True)
With txtB1
.Name = "TxtBx" & NL
.Height = 25.5
.Width = 150
.Left = 150
.Top = 18 * NL * 2
End With
Next NL
UserForm2.Show
'This is UserForm2
Private Sub CommandButton1_Click()
Cells(10, 10) = Controls.TxtBx1.Value
Cells(10, 11) = Controls.TxtBx2.Value
Cells(10, 12) = Controls.TxtBx3.Value
End sub
You have to address the code-generated controls like this: Controls.Item("ControlName").Value
So the following should work:
Private Sub CommandButton1_Click()
Cells(10, 10) = Controls("TxtBx1").Value
Cells(10, 11) = Controls("TxtBx2").Value
Cells(10, 12) = Controls("TxtBx3").Value
'This works too
'Cells(10, 10) = Controls.Item("TxtBx1").Value
End sub
Furthermore the setting of the Textbox.Name-property is redundant.
This line is not required:
.Name = "TxtBx" & NL
Related
All,
I have the below code which creates a dynamic userform based on a list located in an excel worksheet. (Please see picture below)
When the user selects submit I would like to extract all the answers from the user form into an excel file.
Does anyone know how I would do this as I have hit a brick wall in thoughts, the user form to my knowledge has to be built via vba as the list of Project ID & UR can vary from 1 line to thousands of lines.
Any help would be much appreciated.
Sub addLabel()
UserForm6.Show vbModeless
Dim theLabel As Object
Dim ComboBox1 As Object
Dim CommandApp As Object
Dim CommandCan As Object
Dim buttonheight As Long
Dim labelCounter As Long
For Each c In Sheets("Sheet1").Range("A1:A100")
If c.Value = "" Then Exit For
Set theLabel = UserForm6.Controls.Add("Forms.label.1", "Test" & c, True)
With theLabel
.Caption = c
.Left = 10
.Width = 50
.Height = 20
.Font.Size = 10
If c.Row = 1 Then
.Top = 34
Else
.Top = 25 + (20 * (c.Row - 1)) + 9
End If
End With
Set ComboBox1 = UserForm6.Controls.Add("Forms.combobox.1", "Test" & c, True)
With ComboBox1
.AddItem "Approved"
.AddItem "Partially Approved"
.AddItem "Not Approved"
.Left = 190
.Width = 120
.Height = 20
.Font.Size = 10
If c.Row = 1 Then
.Top = 30
Else
.Top = 30 + (20 * (c.Row - 1))
buttonheight = 30 + (20 * (c.Row - 1))
End If
End With
Next c
For Each c In Sheets("Sheet1").Range("B1:B100")
If c.Value = "" Then Exit For
Set theLabel = UserForm6.Controls.Add("Forms.label.1", "Test" & c, True)
With theLabel
.Caption = c
.Left = 90
.Width = 70
.Height = 20
.Font.Size = 10
If c.Row = 1 Then
.Top = 34
Else
.Top = 25 + (20 * (c.Row - 1)) + 9
End If
End With
Next c
With UserForm6
.Width = 340
.Height = buttonheight + 90
End With
Set CommandApp = UserForm6.Controls.Add("Forms.Commandbutton.1", "Test" & c, True)
With CommandApp
.Caption = "Submit"
.Left = 10
.Width = 140
.Font.Size = 10
.Top = buttonheight + 30
End With
Set CommandCan = UserForm6.Controls.Add("Forms.Commandbutton.1", "Test" & c, True)
With CommandCan
.Caption = "Cancel"
.Left = 170
.Width = 140
.Font.Size = 10
.Top = buttonheight + 30
End With
End Sub
You will need create variables to hold references to the newly created CommandButtons. By adding the WithEvents modifier you will be able to receive the CommandButton events.
Naming the controls after cell values is problematic. A better solution is to use the MSForms Control Tag property to hold your references. In my example below I add a qualified reference to the target cell.
Changed the subroutines name from addLabel to something more meaningful Show_UserForm6.
Combobox values as they are added.
Userform6 Module
Option Explicit
Public WithEvents CommandApp As MSForms.CommandButton
Public WithEvents CommandCan As MSForms.CommandButton
Private Sub CommandApp_Click()
Dim ctrl As MSForms.Control
For Each ctrl In Me.Controls
If TypeName(ctrl) = "ComboBox" Then
Range(ctrl.Tag).Value = ctrl.Value
End If
Next
End Sub
Private Sub CommandCan_Click()
Unload Me
End Sub
Refactored Code
Sub Show_UserForm6()
Const PaddingTop = 34, Left1 = 10, Left2 = 90, Left3 = 190
Dim c As Range
Dim Top As Single
Top = 34
With UserForm6
.Show vbModeless
For Each c In Sheets("Sheet1").Range("A1:A100")
If c.Value = "" Then Exit For
With getNewControl(.Controls, "Forms.Label.1", Left1, 50, 20, Top)
.Caption = c.Value
.Tag = "'" & c.Parent.Name & "'!" & c.Address
End With
With getNewControl(.Controls, "Forms.Label.1", Left2, 50, 20, Top)
.Caption = c.Offset(0, 1).Value
.Tag = "'" & c.Parent.Name & "'!" & c.Offset(0, 2).Address
End With
With getNewControl(.Controls, "Forms.ComboBox.1", Left3, 120, 20, Top)
.List = Array("Approved", "Partially Approved", "Not Approved")
.Tag = "'" & c.Parent.Name & "'!" & c.Offset(0, 2).Address
.Value = c.Offset(0, 2).Value
End With
Top = Top + 20
Next
Set .CommandApp = getNewControl(.Controls, "Forms.Commandbutton.1", 10, 140, 20, Top + 10)
With .CommandApp
.Caption = "Submit"
End With
Set .CommandCan = getNewControl(.Controls, "Forms.Commandbutton.1", 170, 140, 20, Top + 10)
With .CommandCan
.Caption = "Cancel"
End With
End With
End Sub
Function getNewControl(Controls As MSForms.Controls, ProgID As String, Left As Single, Width As Single, Height As Single, Top As Single) As MSForms.Control
Dim ctrl As MSForms.Control
Set ctrl = Controls.Add(ProgID)
With ctrl
.Left = Left
.Width = Width
.Font.Size = 10
.Top = Top
End With
Set getNewControl = ctrl
End Function
Generally I'd set up classes and collections to hold references to your new controls.
It can work with your current set up though. First off I'll suggest an aesthetic change:
Set the size of your frame to a static size that fits on your screen and add the two command buttons outside of this.
Size the frame so it sits inside the bounds of your form.
Change the ScrollBars property to 2 - fmScrollBarsVertical.
In your code:
Add a new variable
Dim fme As Frame
Set fme = UserForm6.Frame1
Update your references to UserForm6 so they reference fme instead when you add the labels and combobox:
Set theLabel = fme.Add("Forms.label.1", "Test" & c, True)
.
.
Set ComboBox1 = fme.Controls.Add("Forms.combobox.1", "Test" & c, True)
.
.
Set theLabel = fme.Controls.Add("Forms.label.1", "Test" & c, True)
Outside your final loop add this line of code (you may have to play around with the maths to get the correct scroll height):
fme.ScrollHeight = buttonheight + 90
Remove the code that adds the two command buttons (as they're now static outside of the frame).
Now your whole form should sit on the page and you can scroll through the controls.
Double-click your command button to add a Click event to it:
Private Sub CommandButton1_Click()
Dim ctrl As Control
Dim x As Long
For Each ctrl In Me.Frame1.Controls
If TypeName(ctrl) = "ComboBox" Then
x = x + 1
ThisWorkbook.Worksheets("Sheet2").Cells(x, 1) = ctrl.Value
End If
Next ctrl
End Sub
The code will go through each combobox on the form and copy the selected value to Sheet2 in the workbook.
Edit:
All the code incorporating the changes I made.
Sub addLabel()
UserForm6.Show vbModeless
Dim theLabel As Object
Dim ComboBox1 As Object
Dim CommandApp As Object
Dim CommandCan As Object
Dim buttonheight As Long
Dim fme As Frame
Dim c As Variant
Dim labelCounter As Long
Set fme = UserForm6.Frame1
For Each c In Sheets("Sheet1").Range("A1:A100")
If c.Value = "" Then Exit For
Set theLabel = fme.Add("Forms.label.1", "Test" & c, True)
With theLabel
.Caption = c
.Left = 10
.Width = 50
.Height = 20
.Font.Size = 10
If c.Row = 1 Then
.Top = 34
Else
.Top = 25 + (20 * (c.Row - 1)) + 9
End If
End With
Set ComboBox1 = fme.Controls.Add("Forms.combobox.1", "Test" & c, True)
With ComboBox1
.AddItem "Approved"
.AddItem "Partially Approved"
.AddItem "Not Approved"
.Left = 190
.Width = 120
.Height = 20
.Font.Size = 10
If c.Row = 1 Then
.Top = 30
Else
.Top = 30 + (20 * (c.Row - 1))
buttonheight = 30 + (20 * (c.Row - 1))
End If
End With
Next c
For Each c In Sheets("Sheet1").Range("B1:B100")
If c.Value = "" Then Exit For
Set theLabel = fme.Controls.Add("Forms.label.1", "Test" & c, True)
With theLabel
.Caption = c
.Left = 90
.Width = 70
.Height = 20
.Font.Size = 10
If c.Row = 1 Then
.Top = 34
Else
.Top = 25 + (20 * (c.Row - 1)) + 9
End If
End With
Next c
fme.ScrollHeight = buttonheight + 90
End Sub
I'm trying to make a grid of Option Buttons from about 10x60 and would like to do so with VBA, but I can't get the attribute changing to work.
So far I got this:
Sub Buttons()
Dim i As Integer
Dim j As Integer
Dim k As Integer
k = 48
For i = 8 To 9
For j = 5 To 15
ActiveSheet.Shapes.Range(Array("OptionButton" & k)).Select
k = k + 1
Selection.Copy
With Sheets("Weekreview")
.Cells(i, j).Select
.Paste
.Shapes.Range(Array("OptionButton" & k)).Select
.OptionButtons(k).GroupName = i - 1
.OptionButtons(k).LinkedCell = Range(j, i)
End With
Next
Next
End Sub
The problem with this is that the program errors at .OptionButtons(k).GroupName with the message "Unable to get the OptionButtons property of the Worksheet class".
Anyone who can help me?
Edit 1: My first try (before I tried pretty much all the ways I could find googling the issue) was to use Selection.GroupName, this didn't work either. It looks like it can't access the attributes. So either the attribute changing is wrong, or the selection is wrong.
Edit 2: I got the entire program working except the changing of the GroupName of an existing OptionButton. Even though Selection.LinkedCell works, Selection.GroupName doesnt.
Your code copy and paste OptionButton & k then refers to OptionButton & k+1 (object doesn't exist).
Look at line were k is incremented:
k = k + 1
Please change all the words
ActiveSheet.Shapes.Range(Array("OptionButton" & k))
to
ActiveSheet.Shapes.Range("Option Button " & k)
Please try this code:
Sub Buttons()
Dim i As Integer
Dim j As Integer
Dim k As Integer
k = 48
For i = 8 To 9
For j = 5 To 15
ActiveSheet.Shapes.Range(Array("OptionButton" & k)).Select
k = k + 1
Selection.Copy
ActiveSheet.Paste
With Selection
.Name = "OptionButton" & k
.Top = Worksheets("Weekreview").Cells(i, j).Top
.Left = Worksheets("Weekreview").Cells(i, j).Left
.GroupName = i - 1
.LinkedCell = Range(j, i)
End With
Next
Next
End Sub
Controls with a naming convention of TypeName# are ActiveX controls (e.g. "OptionButton1","TextBox1"). The object itself is wrapped in an OLEObject. ActiveX controls on a Worksheet should be references using the Worksheet's OLEObjects collection.
Properties not available directly from the OLEObject can be access by the OLEObject.Object.
Sub Buttons()
Application.ScreenUpdating = False
Dim opt As OLEObject
Dim cell As Range
With Sheets("Weekreview")
For Each cell In Range(Cells(8, 5), Cells(9, 15))
Set opt = .OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, DisplayAsIcon:=False, Width:=108, Height:=21)
With opt
.Left = cell.Left
.Top = cell.Top
.Width = cell.Width
.LinkedCell = cell
.Name = cell.Address(False, False)
With opt.Object
.GroupName = cell.Row
.Caption = cell.Address(False, False)
End With
End With
Next
End With
Application.ScreenUpdating = True
End Sub
I could really use some help on this. I've read through about 60+ websites and it's either not clicking (pun intended), or it's incorrect for my application. Here's the rundown:
Goal: Use a "Submit" button that was dynamically created in a Userform to copy the Caption from an OptionButton to a dynamic cell on the worksheet, and then clear/close the Userform.
Background: The userform is called from a change in a column in the worksheet.
Here's a snippet of the code used to call the userform:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim lastRow As Long
With Worksheets("Test")
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("B1:B" & lastRow), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, 1).ClearContents
Else
With .Offset(0, 1)
.NumberFormat = "mmm dd yyyy hh:mm:ss"
.Value = Now
UserForm1.Show
End With
End If
Application.EnableEvents = True
End If
End With
End Sub
After the Userform is shown, it initializes. It pulls from a list on the spreadsheet to populate how many option buttons there are, their captions, and the dimensions of each item on the Userform. The code for that is this:
Sub UserForm_Initialize()
Dim HLastRow As Integer
Dim NoOfExplanations As Integer
Dim TopPixels As Integer
Dim UserFormHeight As Integer
Dim UserFormWidth As Integer
Dim Opt As Variant
Dim i As Integer
Dim ExplanationRow As Integer
Dim lbl As MSForms.Label
Dim LabelCap As String
Dim btn As CommandButton
Dim OtherInput As MSForms.TextBox
Dim Margins As Integer
With Worksheets("Test")
HLastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
End With
NoOfExplanations = Application.WorksheetFunction.CountA(Worksheets("Test").Range("H2:H" & HLastRow))
Margins = 20
LabelCap = "You have chosen a non sequential row for your team/subteam. Please select an explanation below before you are able to proceed"
UserFormWidth = Len(LabelCap) * 2
TopPixels = (18 * 2)
UserFormHeight = TopPixels + 80 + (20 * NoOfExplanations)
With UserForm1
.Width = UserFormWidth + 40
.Height = UserFormHeight
End With
Set lbl = UserForm1.Controls.Add("Forms.Label.1")
With lbl
.Top = 10
.Left = 20
.Height = 20
.Width = UserFormWidth - 20
.Caption = LabelCap
End With
ExplanationRow = 2
For i = 1 To NoOfExplanations
Set Opt = UserForm1.Controls.Add("Forms.OptionButton.1", "OptionButton" & i, True)
Opt.Caption = Worksheets("Test").Cells(ExplanationRow, 8).Value
If Worksheets("Test").Cells(ExplanationRow, 8).Value = "Other" Then
Set OtherInput = UserForm1.Controls.Add("Forms.TextBox.1")
With OtherInput
.Top = TopPixels
.Width = UserFormWidth - (Len(Worksheets("Test").Cells(ExplanationRow, 8).Value) * 11)
.Left = UserFormWidth - (UserFormWidth - (Len(Worksheets("Test").Cells(ExplanationRow, 8).Value) * 11))
.Height = 18
End With
End If
If Len(Worksheets("Test").Cells(ExplanationRow, 8).Value) > 45 Then
Opt.Width = UserFormWidth - 10
Opt.Height = 36
Opt.Left = 18
Opt.Top = TopPixels
TopPixels = TopPixels + 38
End If
If Len(Worksheets("Test").Cells(ExplanationRow, 8).Value) <= 45 Then
Opt.Width = UserFormWidth - 10
Opt.Height = 18
Opt.Left = 18
Opt.Top = TopPixels
TopPixels = TopPixels + 20
End If
ExplanationRow = ExplanationRow + 1
Next i
Set btn = UserForm1.Controls.Add("Forms.CommandButton.1")
With btn
.Top = TopPixels
.Width = 40
.Left = ((UserFormWidth + 40) / 2) - 20
.Height = 20
.Caption = "Submit"
.Name = btn
End With
End Sub
Question: So, how do I get the btn created here in the Userform to both copy the selected OptionButton caption to the dynamic cell, and then clear/close the Userform?
I know it's a stretch, but I'm trying to fill in the cell that is two columns over from the "Target" cell that triggers the Userform to open. The code fills in the current date/time in the .Offset(0, 1) in the Worksheet_Change snipped, but is there a way to place the OptionButton caption in the cell at .Offset(0, 2)?
I'm still pretty new to VBA and this one thing is really sticking a thorn in me.
I'll be incredibly grateful for any help on this.
Thanks!
Joe
Changing your btn variable to a class level variable and using WithEvents will allow you to access the dynamic buttons events.
Private WithEvents btn As CommandButton
Private Sub btn_Click()
Dim ctrl As Control
For Each ctrl In Me.Controls
If TypeName(ctrl) = "OptionButton" Then
If ctrl.Object.Value Then
MsgBox ctrl.Object.Caption
End If
End If
Next
End Sub
I am having a problem with a program for my Excel VBA course. I have written a program to add 5 each of lines, rectangles, ovals and triangles to a worksheet this is the btnAddShapes click event. In the cmdAlignRectangles click event I am trying to take only the rectangles that were added and align them all in the C column. I have used a For Each loop to select all the shapes on the sheet, the For Each loop structure is required for the assignment. Then I used an If/Then statement to select the shape Type msoShapeRectangle. I used the name that I assigned in when creating the rectangles such as "Box1" using the counter I to iterate through each rectangle, it is this statement that is giving me an error saying that the item with that name was not found. I must use the Left property of the Range and Shape objects to move the rectangles.? Any help or guidance would be greatly appreciated.
Private Sub btnAddShapes_Click()
Randomize
For I = 1 To 5
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 50, 100, 100, 65).Select
With Selection
.Name = "Box" & I
.Left = Int(422 * Rnd)
.Top = Int(422 * Rnd)
End With
ActiveSheet.Shapes.AddLine(10 + I * (Rnd * 133), 50 + I * (Rnd * 133), 125 + I * (Rnd * 133), 250 + I * (Rnd * 133)).Select
With Selection
.Name = "Line" & I
End With
ActiveSheet.Shapes.AddShape(msoShapeOval, 275, 240, 108, 44).Select
With Selection
.Name = "Oval" & I
.Left = Int(444 * Rnd)
.Top = Int(444 * Rnd)
End With
ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, 514, 220, 93, 71).Select
With Selection
.Name = "Triangle" & I
.Left = Int(377 * Rnd)
.Top = Int(377 * Rnd)
End With
Next I
End Sub
Private Sub btnRemoveShapes_Click()
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
If Not (sh.Type = msoOLEControlObject Or sh.Type = msoFormControl Or sh.Type = msoTextBox) Then sh.Delete
Next sh
End Sub
Private Sub cmdAlignRectangles_Click()
Dim allRectangles As Shapes
Dim sh As Shape
Dim I As Integer
Set allRectangles = ActiveSheet.Shapes
I = 1
For Each sh In allRectangles
If sh.Type = msoShapeRectangle Then
ActiveSheet.Shapes("Box" & I).Left = Cells(I, 3).Left
End If
I = I + 1
Next
End Sub
The error is that in the creation loop you create 4 shapes for each 1, I going from 1 to 5. On the other hand, in the alignment loop you iterate one I for each shape. Therefore, when I reaches 6 (with the 6th shape), the object named "Box6" does not exist.
A simpler way to achieve this would be to modify our test by examining the name of the shape, like this, for example:
If sh.Type = msoShapeRectangle And InStr(sh.Name, "Box") = 1 Then
sh.Left = Cells(I, 3).Left
End If
p.s. you can also drop the first part of the test
I am using a form to show outstanding work. the code creates a number of textboxes based on the number of rows used on a sheet call "Jobcardslive"
I can get it to create the right number of textboxes on the form but i would also like to populate the textboxes with a value stored in Row A
e.g If I have 4 rows populated on the sheet it will create 4 textboxes named vehicle1 - 4 etc
I would also like it to populate vehicle1 with A1 from the sheet and vehicle2 with A2 etc
The boxes are created fine
the code i am using at the moment is
Dim txtB1 As Control
Dim TextBox_Name As String
Dim f As String
f = ThisWorkbook.Sheets("Jobcardslive").Range("A" & Rows.Count).End(xlUp).Row - 1
Dim i
For i = 0 To f
Set txtB1 = Controls.Add("Forms.TextBox.1")
With txtB1
.Name = "vehicle" & i
.Height = 20
.Width = 200
.Left = 10
.Top = 10 * i * 2
End With
Next i
Any help would be greatly appreciated
you could go like follows:
Dim txtB1 As MSForms.TextBox '<--| declare it as a TextBox instead of Control, to have Intellisense show you real `Textbox` object specific members
Dim i As Long
With ThisWorkbook.Sheets("Jobcardslive")
For i = 1 To .Range("A" & .Rows.Count).End(xlUp).Row
Set txtB1 = Me.Controls.Add("Forms.TextBox.1")
SetTextBox txtB1, i, Range("A" & i).value
Next i
End With
thus also demanding to the following specific Sub SetTextBox the task of properly initializing the textbox:
Sub SetTextBox(txtB As MSForms.TextBox, i As Long, v As Variant)
With txtB
.name = "vehicle" & i
.height = 20
.Width = 200
.Left = 10
.Top = 10 * i * 2
.value = v
End With
End Sub