I am building a userform (variable amount of input boxes) at runtime with the following code:
Private sub Userform_Initialize()
Dim num as Long
Dim i as long
Dim inputBx as Control
num = 10
For i=1 to num
'Referencing the name of textboxes for later
Set inputBx = Controls.Add("Forms.TextBox.1","inputBx" & i)
With inputBx
.Height = 20
.Width = 100
.Left = 20
.Top = 20 * i
End With
Next i
And this works perfectly, it creates the boxes just as I want them. I also created a button in the useform manually to submit the inputs in these boxes but I can't seem to get it to work to write data where i want. This is what I tried
Private Sub SubmitButton_click()
Dim ws as Worksheet
Set ws = Workseets("Test")
For i = 1 to num
ws.Range("A" & i).Value = "inputBx"&i.Value
Next i
End Sub
I have also tried just using these to see if I could see what data was there
MsgBox(Me.inputBx1)
MsgBox(Me.inputBx1.Value)
MsgBox(inputBx1.Value)
but nothing I do seems to work so how can I point to the data in the text boxes so that I can paste the input data somewhere in a sheet?
You can do something like
ws.Range("A" & i).Value = Me.Controls("inputBx" & CStr(i)).Value
Related
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.
This question already has answers here:
How to resize all images on a worksheet?
(2 answers)
Closed 3 years ago.
Ok i have an image that a 3rd part software is placing into an excel file. in order to get the resolution needed it has to be sized much larger than needed. It will always be placed in the same location and be a specific size. I need to resize it. Ideally it would be automatic when the excel file opens but i think any vba code would end up acting before the information is inserted, but if there was a small delay that would be cool too. Alternatively i could make do with a button that runs a bit of code. The code below works, but only when the picture is specifically named "Picture 179" which it won't be ever again or at least until the counter recycles.
The image is inserted at Cell A45 specifically but it extends through roughly cell AZ60.
Here is what i've got that doesn't work.
Private Sub Resize_Graph_Click()
ActiveSheet.Shapes.Range(Array("Picture 179")).Select
Selection.ShapeRange.Height = 104.4
Selection.ShapeRange.Width = 486.72
End Sub
You still need to work out when to resize the picture, but the example code below shows how you can specifically access a picture where the Top-Left corner of the picture is located within a given cell.
Option Explicit
Sub TestMe()
Dim thePicture As Shape
Set thePicture = GetPictureAt(Range("A45"))
If Not thePicture Is Nothing Then
Debug.Print "found it! (" & thePicture.Name & ")"
With thePicture
.Height = 75
.Width = 75
Debug.Print "resized to h=" & .Height & ", w=" & .Width
End With
Else
Debug.Print "couldn't find the picture!"
End If
End Sub
Private Function GetPictureAt(ByRef thisCell As Range) As Shape
Dim thisCellTop As Long
Dim thisCellBottom As Long
Dim thisCellLeft As Long
Dim thisCellRight As Long
With thisCell
thisCellTop = .Top
thisCellLeft = .Left
thisCellBottom = thisCellTop + .Height
thisCellRight = thisCellLeft + .Width
End With
Dim shp As Variant
With Sheet1
For Each shp In .Shapes
If shp.Type = msoPicture Then
If (shp.Top >= thisCellTop) And (shp.Top <= thisCellBottom) Then
If (shp.Left >= thisCellLeft) And (shp.Left <= thisCellRight) Then
Set GetPictureAt = shp
Exit Function
End If
End If
End If
Next shp
End With
End Function
Here is what i settled on.
Private Sub Resize_Graph_Click()
'resize all shapes
Dim s As Shape
Dim ws As Worksheet
Set ws = ActiveSheet
For Each s In ActiveSheet.Shapes
s.LockAspectRatio = msoFalse
s.Width = 491.72
s.Height = 106.56
Next s
'set header shapes and button back to original size
ActiveSheet.Shapes.Range(Array("Company Label")).Select
Selection.ShapeRange.Height = 43.92
Selection.ShapeRange.Width = 131.76
ActiveSheet.Shapes.Range(Array("Product Label")).Select
Selection.ShapeRange.Height = 49.68
Selection.ShapeRange.Width = 134.64
ActiveSheet.Shapes.Range(Array("Resize_Graph")).Select
ActiveSheet.Shapes("Resize_Graph").Height = 38.16
ActiveSheet.Shapes("Resize_Graph").Width = 105.12
'keep button from moving after changing shape back and forth
ActiveSheet.Shapes.Range(Array("Resize_Graph")).Select
ActiveSheet.Shapes("Resize_Graph").Left = 380
ActiveSheet.Shapes("Resize_Graph").Top = 5
ActiveWorkbook.Close Savechanges:=True
End Sub
I've got a question concerning combobox in Excel.
I've got an excel sheet that by default contains two comboboxes and their number is described by a variable x (x=2 by default). Each combobox is scripted to behave in a particular way in subs, for example I've got: private sub ComboBox1_DropButtonClick().
Nonetheless, sometimes I need to increase the number of these boxes by changing the value of X. I may need up to 10 comboboxes in total. Now the question is whether there's any way in which I can set the behaviour of an infinite number of comboboxes (for example in the event of DropButtonClick). What I did was to write a code for each of those comboboxes, so I've got a sub for ComboBox1_DropButtonClick(), ComboBox2_DropButtonClick(), ComboBox3_DropButtonClick(), etc.. The code varies a bit, but it's repeatable. So it all looks rather dumb and I'm searching for some more ingenious solution. Maybe all those comboboxes can be scripted in one go? If there's any way to do it, please share it with me.
Thanks, Wojciech.
[edit] Location of my code (marked in grey):
Screenshot from VBA editor in VBA
Here is some code to dynamically add controls to an Excel Userform, and add the code behind. The code added will make it display a MessageBox when the ComboBox receives a KeyDown.
The code is somewhat commented, but let me know if you have questions :)
Option Explicit
Sub CreateFormComboBoxes(NumberOfComboBoxes As Long)
Dim frm As Object
Dim ComboBox As Object
Dim Code As String
Dim i As Long
'Make a blank form called 'UserForm1', or any name you want
'make sure it has no controls or any code in it
Set frm = ThisWorkbook.VBProject.VBComponents("UserForm1")
With frm
For i = 1 To NumberOfComboBoxes
Set ComboBox = .designer.Controls.Add("Forms.ComboBox.1")
'Set the properties of the new controls
With ComboBox
.Width = 100
.Height = 20
.Top = 20 + ((i - 1) * 40) 'Move the control down
.Left = 20
.Visible = True
.ZOrder (1)
.Name = "ComboBox" & i
End With
'Add your code for each module, you can add different code, by adding a if statement here
'And write the code depending on the name, index, or something else
Code = Code & vbNewLine & "Private Sub " & "ComboBox" & i & "_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)" & _
vbNewLine & " MsgBox(""hi"")" & vbNewLine & "End Sub"
Next
'Add the code
.CodeModule.InsertLines 2, Code
End With
End Sub
'Run this
Sub Example()
CreateFormComboBoxes 5
End Sub
**Edit**
I figured I might as well add the other approach for adding controls dynamically to an Excel sheet. I'd recommend sticking to UserForms, but, here's a method that should help out when controls are needed in a Sheet.
Sub addCombosToExcelSheet(MySheet As Worksheet, NumberOfComboBoxes As Long, StringRangeForDropDown As String)
Dim i As Long
Dim combo As Shape
Dim yPosition As Long
Dim Module As Object
yPosition = 20
For i = 1 To NumberOfComboBoxes
yPosition = (i - 1) * 50
'Create the shape
Set combo = MySheet.Shapes.AddFormControl(xlDropDown, 20, yPosition, 100, 20)
' Range where the values are stored for the dropDown
combo.ControlFormat.ListFillRange = StringRangeForDropDown
combo.Name = "Combo" & i
Code = "Sub Combo" & i & "_Change()" & vbNewLine & _
" MsgBox(""hi"")" & vbNewLine & _
"End Sub"
'Add the code
With ThisWorkbook
'Make sure Module2 Exits and there is no other code present in it
Set Module = .VBProject.VBComponents("Module2").CodeModule
Module.AddFromString (Code)
End With
'Associate the control with the action, don't include the () at the end!
combo.OnAction = "'" & ActiveWorkbook.Name & "'!Combo" & i & "_Change"
Next
End Sub
Sub Example()
Dim sht As Worksheet: Set sht = ThisWorkbook.Sheets(1)
addCombosToExcelSheet sht, 10, "Sheet1!$A$1:$A$10"
End Sub
I've an excel vba form named as 'UserForm'. Overall, there's a button (name as 'buttonAdd') that the function could create/add textbox based on inputed (from 'a' variabel) value dynamically. Here's the code.
Public Sub buttonAdd_Click()
Dim a As Integer
a = TextBox1.Value
Dim cCntrl As Control
For i = 1 To a
Set cCntrl = Me.Controls.Add("Forms.TextBox.1", "quarter", True)
With cCntrl
.Name = "quarter" & d
.Width = 150
.Height = 25
.Top = 100 + (d * 25)
.Left = 220
.ZOrder (0)
End With
Next i
Now, I've a problem. I can't take/get the value from those dynamic textbox. I tried using this code for saving the value into 'A1' cell, but it's doesnt work.
Private Sub SaveButton_Click()
Dim a As Integer
Dim Ws As Worksheet
Dim cCntrl As Control
Set Ws = Worksheets("Sheet1")
Ws.Range("A1").Value = quarter1.Value
End Sub
I thought the name of first dynamic textbox is quarter1, but when I tried to get the value, it didn't work. Is there anyway or hint for solving this issue. Just saying: just take the value of the first text box, write it there, then take another one and so on.
Thanks a lot.
Looks like your problem is a simple typo. You have used d instead of i (d is undefined in your code). I recommend always using Option Explicit.
Public Sub buttonAdd_Click()
Dim a As Long ' Minor, but Integer I sjust too short these days for a lot of things.
Dim i as Long
a = TextBox1.Value
Dim cCntrl As Control
For i = 1 To a
Set cCntrl = Me.Controls.Add("Forms.TextBox.1", "quarter", True)
With cCntrl
.Name = "quarter" & CStr(i) ' explicit rather than implicit conversion
.Width = 150
.Height = 25
.Top = 100 + (i * 25)
.Left = 220
.ZOrder (0)
End With
Next I
Edit: Might be a couple more typos in the .Add command (e.g. you might have wanted "quarter" & "1" instead of just "quarter"?) but I don't have the VBA reference up at the moment to check.
I'm having a problem assigning VBA generated ActiveX checkboxes to a class module. When a user clicks a button, the goal of what I am trying to achieve is: 1st - delete all the checkboxes on the excel sheet; 2nd - auto generate a bunch of checkboxes; 3rd - assign a class module to these new checkboxes so when the user subsequently clicks one of them, the class module runs.
I've borrowed heavily from previous posts Make vba code work for all boxes
The problem I've having is that the 3rd routine (to assign a class module to the new checkboxes) doesn't work when run subsequently to the first 2 routines. It runs fine if run standalone after the checkboxes have been created. From the best I can tell, it appears VBA isn't "releasing" the checkboxes after they have been created to allow the class module to be assigned.
The below code is the simplified code that demonstrates this problem. In this code, I use a button on "Sheet1" to run Sub RunMyCheckBoxes(). When button 1 is clicked, the class module did not get assigned to the newly generated checkboxes. I use button 2 on "Sheet1" to run Sub RunAfter(). If button 2 is clicked after button 1 has been clicked, the checkboxes will be assigned to the class module. I can't figure out why the class module won't be assigned if just the first button is clicked. Help please.
Module1:
Public mcolEvents As Collection
Sub RunMyCheckboxes()
Dim i As Double
Call DeleteAllCheckboxesOnSheet("Sheet1")
For i = 1 To 10
Call InsertCheckBoxes("Sheet1", i, 1, "CB" & i & "1")
Call InsertCheckBoxes("Sheet1", i, 2, "CB" & i & "2")
Next
Call SetCBAction("Sheet1")
End Sub
Sub DeleteAllCheckboxesOnSheet(SheetName As String)
Dim obj As OLEObject
For Each obj In Sheets(SheetName).OLEObjects
If TypeOf obj.Object Is MSForms.CheckBox Then
obj.Delete
End If
Next
End Sub
Sub InsertCheckBoxes(SheetName As String, CellRow As Double, CellColumn As Double, CBName As String)
Dim CellLeft As Double
Dim CellWidth As Double
Dim CellTop As Double
Dim CellHeight As Double
Dim CellHCenter As Double
Dim CellVCenter As Double
CellLeft = Sheets(SheetName).Cells(CellRow, CellColumn).Left
CellWidth = Sheets(SheetName).Cells(CellRow, CellColumn).Width
CellTop = Sheets(SheetName).Cells(CellRow, CellColumn).Top
CellHeight = Sheets(SheetName).Cells(CellRow, CellColumn).Height
CellHCenter = CellLeft + CellWidth / 2
CellVCenter = CellTop + CellHeight / 2
With Sheets(SheetName).OLEObjects.Add(classtype:="Forms.CheckBox.1", Link:=False, DisplayAsIcon:=False, Left:=CellHCenter - 8, Top:=CellVCenter - 8, Width:=16, Height:=16)
.Name = CBName
.Object.Caption = ""
.Object.BackStyle = 0
.ShapeRange.Fill.Transparency = 1#
End With
End Sub
Sub SetCBAction(SheetName)
Dim cCBEvents As clsActiveXEvents
Dim o As OLEObject
Set mcolEvents = New Collection
For Each o In Sheets(SheetName).OLEObjects
If TypeName(o.Object) = "CheckBox" Then
Set cCBEvents = New clsActiveXEvents
Set cCBEvents.mCheckBoxes = o.Object
mcolEvents.Add cCBEvents
End If
Next
End Sub
Sub RunAfter()
Call SetCBAction("Sheet1")
End Sub
Class Module (clsActiveXEvents):
Option Explicit
Public WithEvents mCheckBoxes As MSForms.CheckBox
Private Sub mCheckBoxes_click()
MsgBox "test"
End Sub
UPDATE:
On further research, there is a solution posted in the bottom answer here:
Creating events for checkbox at runtime Excel VBA
Apparently you need to force Excel VBA to run on time now:
Application.OnTime Now ""
Edited lines of code that works to resolve this issue:
Sub RunMyCheckboxes()
Dim i As Double
Call DeleteAllCheckboxesOnSheet("Sheet1")
For i = 1 To 10
Call InsertCheckBoxes("Sheet1", i, 1, "CB" & i & "1")
Call InsertCheckBoxes("Sheet1", i, 2, "CB" & i & "2")
Next
Application.OnTime Now, "SetCBAction" '''This is the line that changed
End Sub
And, with this new formatting:
Sub SetCBAction() ''''no longer passing sheet name with new format
Dim cCBEvents As clsActiveXEvents
Dim o As OLEObject
Set mcolEvents = New Collection
For Each o In Sheets("Sheet1").OLEObjects '''''No longer passing sheet name with new format
If TypeName(o.Object) = "CheckBox" Then
Set cCBEvents = New clsActiveXEvents
Set cCBEvents.mCheckBoxes = o.Object
mcolEvents.Add cCBEvents
End If
Next
End Sub
If OLE objects suit your needs then I'm glad you've found a solution.
Are you aware, though, that Excel's Checkbox object could make this task considerably simpler ... and faster? Its simplicity lies in the fact that you can easily iterate the Checkboxes collection and that you can access its .OnAction property. It is also easy to identify the 'sender' by exploiting the Evaluate function. It has some formatting functions if you need to tailor its appearance.
If you're after something quick and easy then the sample below will give you an idea of how your entire task could be codified:
Public Sub RunMe()
Const BOX_SIZE As Integer = 16
Dim ws As Worksheet
Dim cell As Range
Dim cbox As CheckBox
Dim i As Integer, j As Integer
Dim boxLeft As Double, boxTop As Double
Set ws = ThisWorkbook.Worksheets("Sheet1")
'Delete checkboxes
For Each cbox In ws.CheckBoxes
cbox.Delete
Next
'Add checkboxes
For i = 1 To 10
For j = 1 To 2
Set cell = ws.Cells(i, j)
With cell
boxLeft = .Width / 2 - BOX_SIZE / 2 + .Left
boxTop = .Height / 2 - BOX_SIZE / 2 + .Top
End With
Set cbox = ws.CheckBoxes.Add(boxLeft, boxTop, BOX_SIZE, BOX_SIZE)
With cbox
.Name = "CB" & i & j
.Caption = ""
.OnAction = "CheckBox_Clicked"
End With
Next
Next
End Sub
Sub CheckBox_Clicked()
Dim sender As CheckBox
Set sender = Evaluate(Application.Caller)
MsgBox sender.Name & " now " & IIf(sender.Value = 1, "Checked", "Unchecked")
End Sub