I am trying to set some command buttons properties out in bulk . That is trying to set various properties of the command buttons in one go rather than repeat the code for each command button individually.
The document has 30+ command buttons.
In the Class - I have put the code below:
Option Explicit
Public WithEvents cMDButtonGroup As CommandButton
Private Sub cMDButtonGroup_Click()
With cMDButtonGroup
If .Caption = "Press" Then
' Add some other button properties
Else
.Caption = " Complete"
End If
End With
In a VBA Module - I have put the code below:
Option Explicit
Dim Buttons() As New cMDButtonClass
Sub Buttons()
Dim ButtonCount As Integer
Dim ctl As Control
' Create the Button objects
ButtonCount = 0
For Each ctl In ActiveDocument.Controls ' This may be wrong
If TypeName(ctl) = "CommandButton" Then
ButtonCount = ButtonCount + 1
ReDim Preserve Buttons(1 To ButtonCount)
Set Buttons(ButtonCount).ButtonGroup = ctl
End If
End If
Next ctl
End Sub
The above may have been sourced from VBA Express? Unfortunately I have lost the link.
Unfortunately I do not know how to proceed to fix this.
Final Solution: Tim's Code works perfectly. You also need to load the buttons
Put the below code in ThisDocument
Private Sub Document_Open()
Call SetupButtons
End Sub
cMDButtonClass (simplified)
Public WithEvents oBtn As CommandButton
Private Sub oBtn_Click()
MsgBox "clicked: " & oBtn.Caption
End Sub
In a regular module:
Dim colButtons As New Collection '< simpler to manage than an array
Sub SetupButtons()
Dim ButtonCount As Integer
Dim ctl, c
Dim oB As cMDButtonClass
'Following Cindy's comment...
For Each ctl In ActiveDocument.InlineShapes
If Not ctl.OLEFormat Is Nothing Then
Set c = ctl.OLEFormat.Object
If TypeName(c) = "CommandButton" Then
Set oB = New cMDButtonClass
Set oB.oBtn = c
colButtons.Add oB
End If
End If
Next ctl
End Sub
Related
I am trying to dynamically create an application that will use the name of a button (created at runtime) on the form, to extract a number from the end of it's name:
FundNo = Right(Me.ActiveControl.Name, 1)
It's not working and I suspect it's because my button isn't the active control as I am using the mouse over event to trigger it which I'm guessing doesn't give it the focus.
It's nothing to do with the data type it's just not returning the name of the control.
Does anyone have any ideas as to how I could do this as it will be really cool if I can get it to work?
Thanks and regards, Mark
You are right, the CommandButton is not the active Control when the mouse moves over it. It is possible to do what you want, but not in a single line of code. You need a WithEvents variable in a Class module to return the events from the CommandButtons ... the following is the process, assuming you already have your UserForm set up and it is correctly adding your CommandButtons ... the following uses "MyUserFormName" as the assumed name of your UserForm, change this in the following to the actual name of your UserForm:
Add the following into the code-behind of your UserForm (the Debug.Print is just to test the code works and you can remove it when it is, if you want to):
Sub CommandButtonMovement(cb As MSForms.CommandButton)
FundNo = Right(cb.Name, 1)
Debug.Print Now, FundNo
End Sub
Add a Class module (must be a Class module ... not standard module), name it CCommandButtonEvents, add this code
Option Explicit
Private WithEvents mCommandButton As MSForms.CommandButton
Private mUserForm As MyUserFormName
Sub SetUpCommandButton(cb As MSForms.CommandButton, uf As MyUserFormName)
Set mCommandButton = cb
Set mUserForm = uf
End Sub
Private Sub mCommandButton_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
mUserForm.CommandButtonMovement mCommandButton
End Sub
... remember to change "MyUserFormName" to the actual name of your UserForm.
Back in your UserForm code-behind, for each CommandButton you create, you need to add the following at the module level:
Dim cbe1 As CCommandButtonEvents
Dim cbe2 As CCommandButtonEvents
... as many as you are adding CommandButtons
Finally, assuming you are dynamically creating your CommandButtons in UserForm_Activate(), then add (where cb1, cb2 is assumed to be the names of the CommandButton ... change this as required) in that method:
Set cbe1 = New CCommandButtonEvents
cbe1.SetUpCommandButton cb1, Me
Set cbe2 = New CCommandButtonEvents
cbe2.SetUpCommandButton cb2, Me
... again, as many as you are adding CommandButtons
Run your code. That's a lot of changes ... I thought it might help to post a full code example:
Class CCommandButtonEvents - as above
UserForm MyUserFormName
Option Explicit
Dim FundNo As Variant
Dim cbe1 As CCommandButtonEvents
Dim cbe2 As CCommandButtonEvents
Private Sub UserForm_Activate()
Dim cb1 As MSForms.CommandButton
Set cb1 = Me.Controls.Add("Forms.CommandButton.1", "CommandButton1", True)
cb1.Caption = "First button"
cb1.Top = 20
cb1.Left = 20
Set cbe1 = New CCommandButtonEvents
cbe1.SetUpCommandButton cb1, Me
Dim cb2 As MSForms.CommandButton
Set cb2 = Me.Controls.Add("Forms.CommandButton.1", "CommandButton2", True)
cb2.Caption = "Second button"
cb2.Top = 20
cb2.Left = 100
Set cbe2 = New CCommandButtonEvents
cbe2.SetUpCommandButton cb2, Me
End Sub
Sub CommandButtonMovement(cb As MSForms.CommandButton)
FundNo = Right(cb.Name, 1)
Debug.Print Now, FundNo
End Sub
If you are adding your CommandButtons in a loop then the example code will need adjusting for that eg to use an Array instead of individual CCommandButtonEvents variables at point 3 etc
EDIT: updated code per the questioners comments, to handle adding CommandButtons in an array and to handle multiple events (MouseMove and Click)
The UserForm code-behind needs some fairly serious re-working though the core principles are the same ... this is the new code that includes an array to hold the CommandButtons and a loop to add them all (change the value of mBtnCount to the number of CommandButtons you want added ... ensure the UserForm is large enough that you can see them all!)
Option Explicit
Const mBtnCount As Long = 5
Dim FundNo As Variant
Dim mCmdBtns() As CCommandButtonEvents
Private Sub UserForm_Activate()
Dim i As Long
ReDim mCmdBtns(1 To mBtnCount)
For i = 1 To mBtnCount
Dim cmdBtn As MSForms.CommandButton
Set cmdBtn = Me.Controls.Add("Forms.CommandButton.1", "CommandButton" & CStr(i), True)
cmdBtn.Caption = "Button " & CStr(i)
cmdBtn.Top = 4 + 26 * (i - 1)
cmdBtn.Left = 4
Set mCmdBtns(i) = New CCommandButtonEvents
mCmdBtns(i).SetUpCommandButton cmdBtn, Me
Next i
End Sub
Sub CommandButtonMovement(cb As MSForms.CommandButton)
FundNo = Right(cb.Name, 1)
Debug.Print Now, "Movement " & FundNo
End Sub
Sub CommandButtonClick(cb As MSForms.CommandButton)
FundNo = Right(cb.Name, 1)
Debug.Print Now, "Click " & FundNo
End Sub
... note there is a new Sub 'CommandButtonClick' that the code in CCommandButtonEvents will call.
Finally, to handle the Click event, in the CCommandButtonEvents Class module (you should normally use the drop-downs at the top of the code window to add the new event handlers to ensure the event 'signature' is correct), add this Sub which calls the new Sub in the UserForm:
Private Sub mCommandButton_Click()
mUserForm.CommandButtonClick mCommandButton
End Sub
I have a userform with many comboboxes and an "Ok" button. What I need is that when pressing that "Ok" button, VBA to check if there's no empty comboboxes. If all comboboxes have some value selected - close the userform otherwise return a message box and clicking "Ok" on that messagebox returns me to the userform with no filled values lost.
I've tried all the methods I could think of:
If PackageOuterRadius = null Then
if PackageOuterRadius is nothing Then
If PackageOuterRadius.value = 0 Then
If IsNull(PackageOuterRadius) = True Then
If IsNull(PackageOuterRadius.value) Then
What I've been trying to do is:
Private Sub Rigid_Filme_Ok_Button_Click()
If PackageOuterRadius.ListCount = 0 Then
MsgBox "Select a ""Package Outer Radius!"
End If
And absolutelly nothing actually checks if the combobox is empty and keeps returning a positive (That there's a value selected)
What could be the solution to this problem? Could someone, please, help me?
If you have few ComboBoxes only, you may insert lines underneath the OK button to check if all the ComboBoxes are filled but if you have too many ComboBoxes on UserForm, you may achieve this with the help of a Class Module and to do so, follow these steps...
Insert a Class Module and rename it to clsUserForm and the place the following code on Class Module...
Code for Class Module:
Public WithEvents mCMB As msforms.ComboBox
Public Sub CheckComboBoxes()
Dim cCtl As msforms.Control
Dim cntCBX As Long
Dim cnt As Long
For Each cCtl In frmMyUserForm.Controls
If TypeName(cCtl) = "ComboBox" Then
cntCBX = cntCBX + 1
If cCtl.Value <> "" Then
cnt = cnt + 1
End If
End If
Next cCtl
If cnt = cntCBX Then
Unload frmMyUserForm
Else
MsgBox "All the ComboBoxes are mandatory.", vbExclamation
End If
End Sub
Then place the following code on UserForm Module. The code assumes that the name of the userForm is frmMyUserForm and the name of the CommandButton is cmdOK.
Code for UserForm Module:
Dim GroupCBX() As New clsUserForm
Dim frm As New clsUserForm
Private Sub cmdOK_Click()
frm.CheckComboBoxes
End Sub
Private Sub UserForm_Initialize()
Dim i As Long
Dim ctl As Control
For Each ctl In Me.Controls
If TypeName(ctl) = "ComboBox" Then
i = i + 1
ReDim Preserve GroupCBX(1 To i)
Set GroupCBX(i).mCMB = ctl
End If
Next ctl
End Sub
And you will be good to go.
I'm trying to call a change event for any Combo Box on a userform.
UPDATE
So following what others have said (For Text Boxes, which I've tested and works for Textboxes), I've create a Class Module Called: 'clsCombo_Update'
Private WithEvents MyComboBox As MSForms.comboBox
Public Property Set Control(cb As MSForms.comboBox)
Set MyComboBox = cb
End Property
Private Sub MyComboBox_Change()
Debug.Print "Change"
End Sub
And in the UserForm I have:
Private Sub UserForm_Initialize()
Dim ctrl As MSForms.Control
Dim obj As clsCombo_Update
Set cbCollection = New Collection
For Each ctrl In Me.Controls
If TypeOf ctrl Is MSForms.comboBox Then
Set obj = New clsCombo_Update
Set obj.Control = ctrl
cbCollection.Add obj
End If
Next ctrl
Set obj = Nothing
End Sub
This setup worked for textboxes but doesn't when I tried to make it work for Combo Boxes
I have a button in a workdbook (wbShared), clicking on that button a second workbook (wbNewUnshared) opens. I want to add a button to wbNewUnshared with code programmatically.
I already found how to add the button, but I didn't find how to add code to this button.
'create button
'--------------------------------------------------------
Dim objBtn As Object
Dim ws As Worksheet
Dim celLeft As Integer
Dim celTop As Integer
Dim celWidth As Integer
Dim celHeight As Integer
Set ws = wbNewUnshared.Sheets("Sheet1")
celLeft = ws.Range("S3").left
celTop = ws.Range("T2").top
celWidth = ws.Range("S2:T2").width
celHeight = ws.Range("S2:S3").height
Set objBtn = ws.OLEObjects.add(classType:="Forms.CommandButton.1", link:=False, _
displayasicon:=False, left:=celLeft, top:=celTop, width:=celWidth, height:=celHeight)
objBtn.name = "Save"
'buttonn text
ws.OLEObjects(1).Object.Caption = "Save"
I found this online:
'macro text
' Code = "Sub ButtonTest_Click()" & vbCrLf
' Code = Code & "Call Tester" & vbCrLf
' Code = Code & "End Sub"
' 'add macro at the end of the sheet module
' With wbNewUnshared.VBProject.VBComponents(ActiveSheet.name).codeModule
' .InsertLines .CountOfLines + 1, Code
' End With
But this gives an error in the last line. Anybody has a clue?
tx
EDIT:
SOLVED
Ok, the code given works, I had an error 'Programmatic Access To Visual Basic Project Is Not Trusted'. Thanks to the help of S Meaden I solved that via https://support.winshuttle.com/s/article/Error-Programmatic-Access-To-Visual-Basic-Project-Is-Not-Trusted.
after that my code worked. So thanks again.
The first code I provided assumes 1 workbook. The code I'm presenting now does not. The limitation of this is that if the arrBttns is lost, the project is reset, the link between the code and the button is lost and the procedure addCodeToButtons has to be run again.
In the wbNewUnshared, create a class module with the following code
Option Explicit
Public WithEvents cmdButtonSave As MSForms.CommandButton
Public WithEvents cmdButtonDoStuff As MSForms.CommandButton
Private Sub cmdButtonDoStuff_Click()
'Your code to execut on "Do Stuff" button click goes here
MsgBox "You've just clicked the Do Stuff button"
End Sub
Private Sub cmdButtonSave_Click()
'Your code to execut on "Save" button click goes here
MsgBox "You've just clicked the Save button"
End Sub
In the wbNewUnshared add a standard module with the following code
Option Explicit
Dim arrBttns() As New Class1
Public Sub addCodeToButtons()
Dim bttn As OLEObject
Dim ws As Worksheet
Dim i As Long
ReDim arrBttns(0)
'Iterate through worksheets
For Each ws In ThisWorkbook.Worksheets
'Iterate through buttons on worksheet
For Each bttn In ws.OLEObjects
'Expand arrBttns for valid buttons.
If bttn.Name = "Save" Or bttn.Name = "DoStuff" Then
If UBound(arrBttns) = 0 Then
ReDim arrBttns(1 To 1)
Else
ReDim Preserve arrBttns(1 To UBound(arrBttns) + 1)
End If
End If
'Link button to correct code
Select Case bttn.Name
Case "Save"
Set arrBttns(UBound(arrBttns)).cmdButtonSave = bttn.Object
Case "DoStuff"
Set arrBttns(UBound(arrBttns)).cmdButtonDoStuff = bttn.Object
End Select
Next bttn
Next ws
End Sub
In the wbNewUnshared add the following code in the ThisWorkbook module, this is to add the code to the buttons on workbook open.
Option Explicit
Private Sub Workbook_Open()
Call addCodeToButtons
End Sub
In the wbShared add the following line after you're done adding buttons
Application.Run "wbNewUnshared.xlsm!addCodeToButtons"
Original Answer
Add a class module to your project to which you add.
Option Explicit
Public WithEvents cmdButton As MSForms.CommandButton 'cmdButton can be an name you like, if changed be sure to also change the Private Sub below
Private Sub cmdButton_Click()
'Your code on button click goes here
MsgBox "You just clicked me!"
End Sub
To a module you add the code below
Option Explicit
Dim arrBttns() As New Class1 'Change Class1 to the actual name of your classmodule
'The sub which adds a button
Sub addButton()
Dim bttn As OLEObject
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set bttn = ws.OLEObjects.Add(ClassType:="Forms.CommandButton.1")
ReDim arrBttns(0)
If UBound(arrBttns) = 0 Then
ReDim arrBttns(1 To 1)
Else
ReDim Preserve arrBttns(1 To UBound(arrBttns))
End If
Set arrBttns(UBound(arrBttns)).cmdBttn = bttn.Object
End Sub
I am creating a program which has several UserForms.
At the end of the program I need to clear every Checkbox inside some UserForm. I have created a Function, but it cannot recognise which UserForm it should clear, can you help me there? Here is the code:
Function ClearUserForm(ByVal userf As String)
Dim contr As Control
For Each contr In userf.Controls
If TypeName(contr) = "CheckBox" Then
contr.Value = False
End If
Next
End Function
And I am calling the function like this, for example:
ClearUserForm ("UserForm2")
It seems not to recognize which UserForm it should act upon.
Shai Rado's advice is good and you should have a look at how he creates the object from its 'key'.
I only post this answer to check if you're aware that you could pass the object itself in the call. So your code could be like so:
Option Explicit
Public Sub RunMe()
ClearCBoxes UserForm1
End Sub
Private Sub ClearCBoxes(frm As MSForms.UserForm)
Dim ctrl As Control
For Each ctrl In frm.Controls
If TypeOf ctrl Is MSForms.ComboBox Then
ctrl.Value = False
End If
Next
End Sub
You don't need a Function (since you are not returning any arguments), in your case a Sub will do.
You need to qualify an Object to the User_Form selected by using:
Set objUserForm = UserForms.Add(userf)
Whole code
(Tested)
Option Explicit
Sub ClearUserForm(ByVal userf As String)
Dim contr As Control
Dim objUserForm As Object
Set objUserForm = UserForms.Add(userf)
For Each contr In objUserForm.Controls
If TypeName(contr) = "CheckBox" Then
contr.Value = False
End If
Next
' just to check that all checkboxes are cleared
objUserForm.Show
End Sub