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.
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.
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
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'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
I have a class called autoCRUD in a class module in excel 2013. From another module (a regular one) I try to call a method from this class and I get the "Object required" exception.
Here's the method:
Public Function CreateCRUDView(TipoCRUD As String) 'TipoCRUD pode ser C (Create), R (Read), U (Update), D (Delete)
Dim myForm As Object
Dim NewFrame As MSForms.Frame
Dim NewButton As MSForms.CommandButton
Dim NewListBox As MSForms.ListBox
Dim NewLabel As MSForms.Label
Dim X As Integer
Dim Line As Integer
Dim t As Integer
Dim arrLeg() As Variant
arrLeg = legenda
'This is to stop screen flashing while creating form
Application.VBE.MainWindow.Visible = False
Set myForm = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)
'Create the User Form
With myForm
.Properties("Caption") = "New Form"
.Properties("Width") = 300
.Properties("Height") = 270
End With
'Criar labels
t = 10
For Each lbl In arrLeg
Set NewLabel = myForm.Designer.Controls.Add("Forms.label.1")
With NewLabel
.name = "lbl_" + Replace(CStr(lbl.Value), " ", "")
.t = (10 + t)
.Left = 10
.Font.Size = 8
End With
t = t + 10
Next
'Create CommandButton Create
Set NewButton = myForm.Designer.Controls.Add("Forms.commandbutton.1")
With NewButton
.name = "cmd_1"
If UCase(TipoCRUD) = "C" Then
.Caption = "Salvar"
ElseIf UCase(TipoCRUD) = "U" Then
.Caption = "Alterar"
End If
.Accelerator = "M"
.Top = Top + 10
.Left = 200
.Width = 66
.Height = 20
.Font.Size = 8
.Font.name = "Tahoma"
.BackStyle = fmBackStyleOpaque
End With
Top = Top + 10
End Function
The code from another module that calls the method is :
Public Sub Main()
Dim ac As autoCrud
Set ac = New autoCrud
ac.CreateCRUDView ("c")
End Sub
I don't get it, why am I getting this error?
Here is the code for "legenda":
Public Property Get sht() As Worksheet
Const shtName As String = "Teste1"
Set sht = ActiveWorkbook.Worksheets(shtName)
End Property
Public Property Get legenda() As Range
Const linha As Integer = 3
Const colunaI As Integer = 2
Dim colunaF As Integer
Dim i As Integer
i = colunaI
Do While sht.Cells(linha, i).Value <> ""
i = i + 1
Loop
colunaF = (i - 1)
Set legenda = sht.Range(Cells(linha, colunaI), Cells(linha, colunaF))
End Property
The lbl.Value is supposed to be a string value, the name of the label. And it comes from the spread sheet in the header of the table, teh legenda() only selects that header and the arrLeg takes the legenda as a range and transforms it in an array.
Edit:
Apparently the error occurs in the line that says: .name = "lbl_" + Replace(CStr(lbl.Value), " ", "")
As you can see, I've tried to take the spaces from the string and also ensure that it is a string, but none of it worked.
Edit 2:
I actually just use a class for organization and re-usability purposes. I take the properties and other methods and use them inside the 'createCRUDView' method, this method will then create a CRUD View, that is, create a form either to "Create", "Read" (not used since it's excel),"Update or "Delete" data entries. It basically creates forms dynamically to any table you make
VBA error 424 is object required error. So I'm now pretty sure that lbl in CStr(lbl.Value) is not an object. With your code legenda is a Range but after
Dim arrLeg() As Variant
arrLeg = legenda
arrLeg will be a variant array. This array does not contain objects. You can debug this with
For Each lbl In arrLeg
...
MsgBox TypeName(lbl)
...
Next
So you should use CStr(lbl).
And
Set legenda = sht.Range(Cells(linha, colunaI), Cells(linha, colunaF))
will only work while the "Teste1" sheet is the ActiveSheet because Cells(linha, colunaI) is not explicit assigned to a sheet so the ActiveSheet will be supposed.
Set legenda = sht.Range(sht.Cells(linha, colunaI), sht.Cells(linha, colunaF))
will be better.