I'm trying to get a property value of a button control from inside the button's click event without using the button's name (since I want to use the same code for each of many buttons on the Excel sheet).
After much research, I see many references to try the following:
Me.ActiveControl.name
or
Me.Shapes(Application.Caller).Name
However, both of those throw an error when executed from within Excel. Note that I'm using Excel 2010.
Thanks for any help in advance.
Lee
What you want is possible but for that you need to create a Class
Do this.
Insert a Class Module and paste this code there.
Option Explicit
Public WithEvents MyButton As MSForms.CommandButton
Private Sub MyButton_Click()
MsgBox MyButton.Name
End Sub
Next Insert a module and place this code there
Dim shpButtons() As New Class1
Sub StartCode()
Dim shp As Shape
Dim btnCount As Long
ReDim shpButtons(1 To 1)
btnCount = 0
For Each shp In ActiveSheet.Shapes
If shp.OLEFormat.Object.OLEType = xlOLEControl Then
btnCount = btnCount + 1
ReDim Preserve shpButtons(1 To btnCount)
Set shpButtons(btnCount).MyButton = shp.OLEFormat.Object.Object
End If
Next
End Sub
Sub StopCode()
Dim iBtn As Long
On Error Resume Next
For iBtn = LBound(shpButtons) To UBound(shpButtons)
Set shpButtons(iBtn).TheText = Nothing
Next
End Sub
Now simply run the Sub StartCode()
Next when you click the ActiveX CommandButton then you will get it's name.
Try ActiveSheet.Shapes(Application.Caller).Name
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 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 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
In VBA for excel, I have a userform then I want this to show only for 1 instance. Even if the user re-open it, it won't open again. Is there any code for it? well, I'm also using this code for my login:
Private Sub UserForm_Initialize()
User.Caption = Environ("Username")
End Sub
I'm thinking if i can use this code in my problem. Hoping for a quick response. thanks guys, you're awesome!
Yes, it's possible.
You have to add new sheet. In a cell A1 type 0 (zero), then hide it. In a code which calls UserForm, use this:
Sub ShowMyForm()
If ThisWorkbook.Worksheets("HiddenSheet").Range("A1")=0 then MyUserForm.Show
End Sub
In a form:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
ThisWorkbook.Worksheets("HiddenSheet").Range("A1")=1
ThisWorkbook.Save()
DoEvents
End Sub
If you don't want to add an extra sheet just to store one bool, you can set a custom document property like this:
Private Sub Workbook_Open()
On Error Resume Next
Dim test As Boolean
test = Me.CustomDocumentProperties("UserFormShown").Value
If Err.Number = 0 Then Exit Sub
UserForm1.Show
Me.CustomDocumentProperties.Add "UserFormShown", False, msoPropertyTypeBoolean, True
End Sub
If the property hasn't been set yet it will throw an error, so trapping an error lets you know if you've set the property (and shown the form).
I have some Forms Checkboxes in Excel 2010. I need to perform some common code when they are clicked. To do this, I'd like to pass a reference to the Checkbox, but so far I'm only able to get it typed as a shape.
To preempt the question, yes, they need to be Form Checkboxes and not ActiveX Checkboxes.
I'm a novice with VBA, so any help is appreciated.
Sub CheckBox1_Click()
'I really want this reference to be a Checkbox, not a Shape
Dim shape As Shape
Set shape = ActiveSheet.Shapes("Check Box 1")
DoSomething(shape)
End Sub
Sub DoSomething(MSForms.CheckBox)
'I need the reference to be a checkbox as I need to check
'whether it's checked or not here
End Sub
In such a scenario, don't have different click event for all checkboxes. Have just one. And use Application.Caller to get the name of the ckeckbox which called it. Pass that as a String to the relevant sub and then work with it.
UNTESTED
Sub CheckBoxMain_Click()
Dim sName As String
sName = Application.Caller
DoSomething (sName)
End Sub
Sub DoSomething(sCheck As String)
Dim shp As shape
Set shp = ActiveSheet.Shapes(sCheck)
With shp
'~~> Do something
End With
End Sub
You could also combine the two into one as well and link it with all checkboxes.
Sub DoSomething()
Dim shp As shape
Set shp = ActiveSheet.Shapes(Application.Caller)
With shp
'~~> Do something
End With
End Sub
This is similar to Siddharth's but adds the ControlFormat property of the Shape. ControlFormat gets you the Intellisense for the CheckBox, in this case Value:
Sub CheckBox1_Click()
Dim chk As Shape
Set chk = ActiveSheet.Shapes(Application.Caller)
With chk.ControlFormat
If .Value = True Then
MsgBox "true"
Else
MsgBox "false"
End If
End With
End Sub