How do I return the name of the userform control that triggered the mouseover class event?
This sounds so simple but honestly I've been racking my brain trying to find the correct syntax...
Here is my userform module:
Option Explicit
Dim dArray() As New Class1
Sub Build_Controls()
Dim dImage As Object, i As Integer
For i = 1 To 3
Set dImage = UserForm1.Controls.Add("Forms.Image.1", i, True)
With dImage
.Left = (25 * i) + 20
.Width = 20
.Top = 10
.Height = 20
End With
ReDim Preserve dArray(1 To i)
Set dArray(i).dImages = dImage
Next i
End Sub
Private Sub UserForm_Activate()
Build_Controls
End Sub
I dynamically create three image controls at runtime aptly named "1", "2", and "3".
I assign each control a mouseover event found in the following class module called "Class1":
Public WithEvents dImages As MSForms.Image
Private Sub dImages_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
MsgBox ("Control Name") 'Which control was triggered?
End Sub
How can I make the MsgBox contain the name of the control that triggered the event?
Me.dImages.Name 'x
ActiveControl.Name 'x
Screen.ActiveControl.Name 'x
UserForm1.ActiveControl.Name 'x
Any help is appreciated.
Thanks,
Mr. J
use this in the class module
do not use msgbox because it puts the VBA editor into background
use Debug.Print, then you can watch the values change on the fly in the immediate window
put a breakpoint at the debug.print line and then examine the dImages object in the watch window ( that is how i got the name attribute )
Option Explicit
Public WithEvents dImages As MSForms.Image
'
Private Sub dImages_Click()
Debug.Print dImages.Name
End Sub
'
Private Sub dImages_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Debug.Print dImages.Name
End Sub
EDIT: seems like I mis-read your question, but
Msgbox dImages.Name
works for me /EDIT
Msgbox dImages.Parent.Name
or something like that - you have a reference to the control in dImages, so you just need to go "up" from there.
If the control isn't hosted directly on the form then you will need to go "up" using .Parent until the parent is not another control:
Dim tmp As Object
Set tmp = dImages.Parent
Do While TypeOf tmp Is MSForms.Control
Set tmp = tmp.Parent
Loop
MsgBox tmp.Name
https://www.mrexcel.com/forum/excel-questions/758496-get-userform-given-control.html
Related
Idea is to have a ComboBox open - when mouse cursor moves over it, without having to click on it, and when mouse moves off it for it to close back down.
Code below seem to be opening it, but with caveats:
a) code keeps firing the Alt + Arrow Down while you are thinking what list item to pick - want it to do it just to open the ComboBox and then stop,
b) once you pick the item, it fires Alt + Arrow Down on a new active cell, which is not the intent. And that new cell prevents ComboBox from opening on the next mouse over.
(*I also have another code, which once list item is picked is finding and selecting corresponding cell in A column)
Private Sub ComboBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
ComboBox1.Activate
SendKeys "%{DOWN}"
End Sub
Some users might find move over solution annoying -- but would be interesting to test it out, if it comes along.
Went with a click anywhere on the Box meantime, as it is better than having to click on an arrow icon only.
Private Sub ComboBox1_GotFocus() 'when clicked on anywhere - not just arrow icon, opens
SendKeys "%{DOWN}"
End Sub
on your form create TextBox1 and ListBox1.
Paste this example code into your form.
Dim autoList As CautoOpenList
Private Sub TextBox1_Enter()
'optional capture of keyboard action to leave textbox
autoList.flipFields True
End Sub
Private Sub ListBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
' optional capture of keyboard action to leave listbox
autoList.flipFields False
End Sub
Private Sub UserForm_Initialize()
ListBox1.List = split("A,B,C,D,E,F",",") ' value your listbox with your values
Set autoList = New CautoOpenList
autoList.Form = Me
autoList.LiBox = ListBox1 ' your listbox name
autoList.TxBox = TextBox1 'your textbox name
End Sub
Then include this class module into your workbook with the name CautoOpenList.
Option Explicit
Private taboff As Boolean, aForm As MSForms.UserForm
Private WithEvents LiBx As MSForms.ListBox
Private WithEvents TxBx As MSForms.TextBox
Private WithEvents Labl As MSForms.Label
Public Property Let LiBox(obj As Object)
Set LiBx = obj
LiBx.Visible = False
End Property
Public Property Let TxBox(obj As Object)
' connect listbox before connecting text box
Set TxBx = obj
With LiBx
.Top = TxBx.Top - 5
.Left = TxBx.Left - 5
End With
'label necessary to capture mouse off-to-right when listbox has scroll bar
Set Labl = aForm.Controls.Add("forms.label.1", "Labl", False)
With Labl
.Top = LiBx.Top
.Height = LiBx.Height
.Width = 5
.Left = LiBx.Left + LiBx.Width
End With
End Property
Public Property Let Form(obj As Object)
' connect from to class before connecting the textbox
Set aForm = obj
End Property
Private Sub LiBx_Click()
TxBx.Text = LiBx.Text
End Sub
Private Sub Labl_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
flipFields False
Debug.Print "MM"
End Sub
Private Sub LiBx_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
With LiBx
If X < 4 Then ' Or X > nRightBound Then
flipFields False
End If
If Y < 4 Or Y > .Height - 6 Then
flipFields False
End If
End With
End Sub
Private Sub TxBx_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
With LiBx
flipFields True
End With
End Sub
Public Sub flipFields(b As Boolean)
LiBx.Visible = b
Labl.Visible = b
TxBx.Visible = Not b
DoEvents
End Sub
I am attempting to assign mouse hover effects on my images on the form based on the TAG attribute that I assign to them. I want only certain photos to have effects applied when the mouse hits them. My difficulty is getting the code to work. I have no issue with it when you are making a new object, but this code requires a loop through controls to find the ones I want the feature applied. I have attached the code to hopefully explain the issue. Any help would be appreciated.
CLASS MODULE cls_ProjectManager_Controls
Option Explicit
Public WithEvents zImage As MSForms.Image
Private index_image As Long
Sub SetImage(ctl As MSForms.Image, ByRef Index As Long)
Set zImage = ctl
index_image = Index
End Sub
Private Sub zImage_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
zImage.BorderStyle = fmBorderStyleSingle
End Sub
Normal Module
Option Explicit
Private pmImageCollection As Collection
Sub initializePropertyManagerControls()
Dim xImage As cls_ProjectManager_controls
Dim x_image As MSForms.Image
Dim ctl As Control
Dim index_image As Long
Dim i As Long
'check that collection is not already empty, if not empty; set the index counter
If pmImageCollection Is Nothing Then
Set pmImageCollection = New Collection
index_image = 1
Else
index_image = pmImageCollection.Count + 1
End If
For Each ctl In frmMasterForm.form_multipage.Pages(2).Controls
If ctl.Tag = "eff_Small_Button" Then
Set x_image = UserForm1.Controls.Add("Forms.Image.1")
With x_image
Set xImage = New cls_ProjectManager_controls
xImage.SetImage x_image, index_image
pmImageCollection.Add xImage
End With
index_image = index_image + 1
End If
Next ctl
End Sub
As you can see it adds the items to collection, but the last effect(addition of border) does not trigger. I have tried rewriting the code from my readings on other similar posts, like this one
Excel VBA Which UserForm Control Triggered Shared MouseOver Class Event? but this code creates controls during the runtime. I am new to the use of Classes so I am unsure how this affects my code.
I have this simple Userform, where I only have TextBox1 and TextBox2. I enter some text in both of them. Assume the focus is on (the cursor is in) the TextBox2. When I click on TextBox1, I want the whole text in this control to be highlighted (selected). Thus I use this code:
Private Sub TextBox1_Enter()
With TextBox1
.SetFocus
.SelStart = 0
.SelLength = Len(.Text)
End With
MsgBox "enter event was fired"
End Sub
There is a MsgBox at the end which is loaded, that means the event works. However, the text is not highlighted. How to fix this?
I use the Enter event and don't want to use the MouseDown event, because I need the code to also work when the TextBox1 is activated programatically, so I feel the Enter event to be the best choice, as it's fired in both cases! Another drawback of the MouseDown event is: when I click for the second time on the TextBox1, I would not expect the whole text to be highlighted anymore, because the focus was set on the first click and it was not changed after I clicked on the same control for the second time; so in this case I would like the cursor to act normally (not to keep the text marked).
Update
When I click once on the TextBox1, I expect to have this result:
If clicked again, the highlight would be removed and the cursor would be placed in the place where it was clicked.
Can't be more simple than this I guess...
Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
With TextBox1
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub
Whether you click on the textbox or you tab into it, it will do what you want. To deselect the text, use the arrow keys.
Explanation
If you debug the code you will see that even though you have said .SetFocus, the focus is not on the Textbox. .SetFocus doesn't work in TextBox1_Enter() and you need to have focus for the rest of the code to work. And hence my alternative...
Alternative
You may also like this version :) This overcomes the limitation of using the mouse in the TextBox
Dim boolEnter As Boolean
Private Sub TextBox1_Enter()
boolEnter = True
End Sub
Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
If boolEnter = True Then
With TextBox1
.SelStart = 0
.SelLength = Len(.Text)
End With
boolEnter = False
End If
End Sub
Pff, took me a while. Actually, your code works, but it highlights the text BEFORE the click event happens. So you clicking in the box instantly overrides the selection created by the code.
I have used a delayed selection, and it works, though it is a bit disgusting...
The code for the textboxes:
Private Sub TextBox1_Enter()
Application.OnTime Now + TimeValue("00:00:01"), "module1.SelectText1"
End Sub
Private Sub TextBox2_Enter()
Application.OnTime Now, "module1.SelectText2"
End Sub
Note that it works even withouth the {+ TimeValue("00:00:01")} part, but it might theoretically stop it from working at times. Hmm, on a second thought, just leave it out. I doubt it would ever cause a problem.
Now the code in module1:
Sub SelectText1()
UserForm1.TextBox1.SelStart = 0
UserForm1.TextBox1.SelLength = Len(UserForm1.TextBox1.Text)
End Sub
Sub SelectText2()
UserForm1.TextBox2.SelStart = 0
UserForm1.TextBox2.SelLength = Len(UserForm1.TextBox2.Text)
End Sub
Hope this works for you too. Ineresting problem. :) Cheers!
I couldn't manage to select/highlight text in the Enter event as the the mousedown and mouseup events coming after are somewhat resetting the selection.
I think the most proper way of achieving what you want is this :
' if you want to allow highlight more then once, reset the variable LastEntered prior to call SelectTboxText:
' LastEntered = ""
' SelectTboxText TextBox2
Dim LastEntered As String
' Button to select Textbox1
Private Sub CommandButton1_Click()
SelectTboxText TextBox1
End Sub
' Button to select Textbox2
Private Sub CommandButton2_Click()
SelectTboxText TextBox2
End Sub
Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
SelectTboxText TextBox1
End Sub
Private Sub TextBox2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
SelectTboxText TextBox2
End Sub
Public Sub SelectTboxText(ByRef tBox As MSForms.TextBox)
If LastEntered <> tBox.Name Then
LastEntered = tBox.Name
With tBox
.SetFocus
.SelStart = 0
.SelLength = Len(.Text)
End With
End If
End Sub
So each time you want to activate one of the textbox programmatically, you should call the sub SelectTboxText, which is not really annoying IMO. I made 2 buttons for this as an example.
This is somewhat an enhancement of what #vacip posted. The benefit you get is that you don't need to add a separate method in the Module for each new textbox.
The following code in your User Form:
'===== User Form Code ========
Option Explicit
Private Sub TextBox1_Enter()
OnTextBoxEnter
End Sub
Private Sub TextBox2_Enter()
OnTextBoxEnter
End Sub
Private Sub TextBox3_Enter()
OnTextBoxEnter
End Sub
The following code goes in a Module:
'===== Module Code ========
Sub SelectAllText()
SendKeys "{HOME}+{END}", True
End Sub
Sub OnTextBoxEnter()
Application.OnTime Now + 0.00001, "SelectAllText", Now + 0.00002
End Sub
Private Sub UserForm_Initialize()
TextBox1.SetFocus
TextBox1.SelStart = 0
TextBox1.SelLength = Len(TextBox1.Text)
End Sub
Add this to the form's code
I know this is well out of date but I'm leaving this here in case it helps someone in my position.
What I want is:
If I click on the box for the first time: select all the text
If I click on it a subsequent time: put the cursor where the mouse is and allow me to use the mouse to select a substring
Firstly it is important to know that "Select all the text" is the default behaviour when tabbing into a TextBox and that "Put the cursor here" is the default behaviour when clicking on a TextBox so we only need to worry about what the mouse is doing.
To do this, we can keep track of the Active Control, but only while the mouse is moving over our TextBox (ie. before the Click)
Code:
Private m_ActiveControlName As String
Private Sub Text1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
m_ActiveControlName = Me.ActiveControl.Name
End Sub
Private Sub Text1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If m_ActiveControlName <> Me.Text1.Name Then
Call Text1_Enter 'we don't have to use Text1_Enter for this, any method will do
Exit Sub 'quit here so that VBA doesn't finish doing its default Click behaviour
End If
End Sub
Private Sub Text1_Enter()
With Text1
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub
There's another solution than the one given by Siddharth.
EDIT: but there's this bug of SendKeys, so the solution I propose below is a lot worse than Siddharth one. I keep it in case one day the bug is corrected...
It relies on the property EnterFieldBehavior of the TextBox field. This property works only when the Tab key is pressed to enter that field, and if this property is fmEnterFieldBehaviorSelectAll (0) the whole field text is automatically selected.
So a dummy caret movement between fields when the form is shown, will activate the feature automatically. For instance this movement can be achieved by pressing Tab to move to the next field, and pressing Shift+Tab to move to the previous field (so back to the original field):
Private Sub UserForm_Activate()
SendKeys "{TAB}+{TAB}"
End Sub
The (very little) advantage of this solution is that you can tune your user form by editing manually the properties EnterFieldBehavior, TabIndex, TabKeyBehavior and TabStop without changing the VBA code anymore to set "select all" on the field with the initial focus.
In short, the VBA code above tells to consider the property EnterFieldBehavior of the field which has the initial focus when the user form is displayed (provided that it's a TextBox or ComboBox field of course).
use this
Private Sub TextBox1_Enter()
With TextBox2
.ForeColor = vbBlack
.Font.Bold = False
End With
With TextBox1
.ForeColor = vbRed
.Font.Bold = True
End With
End Sub
Private Sub TextBox2_Enter()
With TextBox1
.ForeColor = vbBlack
.Font.Bold = False
End With
With TextBox2
.ForeColor = vbRed
.Font.Bold = True
End With
End Sub
The behavior you're trying to implement is already built in to the TextBox. When you move the mouse over the left side of the text box, the mouse pointer will point to the right. If you click, it will select all the text in the field. Clicking anywhere else will deselect the text.
I will try a few other strategies to see if I can get this to work in one Sub.
Try the same code with TextBox1_MouseDown. It should work.
Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
With TextBox1
.SetFocus
.SelStart = 0
.SelLength = Len(.Text)
End With
MsgBox "Text in TextBox1 is selected"
End Sub
I'm working in Excel on a Userform. Essentially, I want a "Photoshop-esque" toolbar that floats over my spreadsheet while I work, allowing me to select and use various tools.
I've got a series of toggle buttons set up so that when one is clicked, any other toggle buttons go back to unclicked. It's a little more complicated because I have sub-buttons, if that makes sense, meaning that once I have a button clicked, I can click one of four other buttons to make my actual selection, and these four buttons are mutually exclusive from each other as well.
The weird thing: I haven't been able to get these buttons to work. Except. For some reason, when I right-click only, the buttons work like a charm. Left-click: nothing. Help please?
Sample button code:
Private Sub tMouse_MouseUp(ByVal button As Integer, _
ByVal shift As Integer, ByVal X As Single, ByVal Y As Single)
tMouse.Value = True
tActual.Value = False
tSched.Value = False
tX.Value = False
tDiam.Value = False
tCirc.Value = False
tTri.Value = False
tTrash.Value = False
tText.Value = False
End Sub
EDIT:
I tried what was suggested about printing the value of the toggle button. And my computer blew up with messageboxes. I had changed all the actions to Click() events. Apparently I was sending the computer through an infinite loop. Maybe the act of changing a button from true to false or vice versa acts like a click and triggers all the other click events?
You have events that are triggering other events. What you'll need to do is set a Boolean AllowEventsToRun variable (either at the module or public level) and set that to false at the start of your code. Run whatever you need to do, and then set it to true at the end.
The trick is to do an if statement to make sure that AllowEventsToRun is set to true before any other code is running. Be sure to initialize the Boolean to true when you load your userform (since the default value of a boolean is false. So something like this:
Option Explicit
Private AllowEventsToRun As Boolean
Private Sub ToggleButton1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If AllowEventsToRun Then
AllowEventsToRun = False
'whatever you're doing that's causing the events to chain fire
AllowEventsToRun = True
End If
End Sub
Private Sub ToggleButton2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If AllowEventsToRun Then
AllowEventsToRun = False
'whatever you're doing that's causing the events to chain fire
AllowEventsToRun = True
End If
End Sub
Private Sub UserForm_Initialize()
AllowEventsToRun = True
End Sub
source: http://www.cpearson.com/excel/SuppressChangeInForms.htm
I would recommend using an "Option" Control instead of a "Toggle" Control.
If you stick 4 options in 1 frame then only 1 of those 4 options will allow itself to be true at a time automatically. You should use the "ToggleButton" control only if you want multiple instances of it to be true at the same time.
However if you refuse to do so and just really want to use ToggleButtons. Then you could write a procedure that is executed once pressing the button that sends it's name (or something else that identifies it uniquely) as a parameter to a procedure that sets all other togglebuttons false except it.
Cheers!
Private Sub ToggleButton1_Click()
Dim s As String
s = "ToggleButton1"
Evaluate_Options s
End Sub
Private Sub ToggleButton2_Click()
Dim s As String
s = "ToggleButton2"
Evaluate_Options s
End Sub
Private Sub ToggleButton3_Click()
Dim s As String
s = "ToggleButton3"
Evaluate_Options s
End Sub
Private Sub ToggleButton4_Click()
Dim s As String
s = "ToggleButton4"
Evaluate_Options s
End Sub
Private Sub ToggleButton5_Click()
Dim s As String
s = "ToggleButton5"
Evaluate_Options s
End Sub
Private Sub ToggleButton6_Click()
Dim s As String
s = "ToggleButton6"
Evaluate_Options s
End Sub
Private Sub ToggleButton7_Click()
Dim s As String
s = "ToggleButton7"
Evaluate_Options s
End Sub
Private Sub ToggleButton8_Click()
Dim s As String
s = "ToggleButton8"
Evaluate_Options s
End Sub
Private Sub Evaluate_Options(s As String)
Dim tgl As Control
For Each tgl In UserForm1.Frame1.Controls
If InStr(tgl.Name, s) Then Set_Toggles_1 tgl
Next
For Each tgl In UserForm1.Frame2.Controls
If InStr(tgl.Name, s) Then Set_Toggles_2 tgl
Next
End Sub
Private Sub Set_Toggles_1(tglTrue As Control)
Dim tglFalse As Control
For Each tglFalse In UserForm1.Frame1.Controls
If tglFalse.Name = tglTrue.Name Then tglFalse = True Else tglFalse = False
Next
End Sub
Private Sub Set_Toggles_2(tglTrue As Control)
Dim tglFalse As Control
For Each tglFalse In UserForm1.Frame2.Controls
If tglFalse.Name = tglTrue.Name Then tglFalse = True Else tglFalse = False
Next
End Sub
Try these basic mouse event capture subs and modify to suit your needs (tMouse = toggle button name):
Private Sub tMouse_Click()
'MsgBox "tb value = " & tMouse.Value
End Sub
Note: upper sub will not work, if lower sub called
Private Sub tMouse_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then MsgBox "Left"
If Button = 2 Then MsgBox "Right"
End Sub
I want to detect when there's a mouse_down on any Frame on the Form while the mouse is still down. I know how to do it for a Click, but I want to catch it before mouse_up.
Thanks
You can create a _MouseDown event handler for each frame on the form, or if you have many frames you can create a generic event handler class
Create a Class module (eg named cUserFormEvents)
Public WithEvents Frme As MSForms.frame
Public frm As UserForm
Private Sub Frme_MouseDown( _
ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
' Put your event code here
MsgBox Frme.Caption
End Sub
Declare a collection for your Frames
Dim mcolFrames As New Collection
Include this code in your form initialistion
Private Sub UserForm_Initialize()
Dim ctl As MSForms.Control
Dim clsEvents As cUserFormEvents
'Loop through all controls on userform
For Each ctl In Me.Controls
'Only process Frames
If TypeOf ctl Is MSForms.frame Then
'Instantiate class module and assign properties
Set clsEvents = New cUserFormEvents
Set clsEvents.Frme = ctl
Set clsEvents.frm = Me
'Add instance to collection
mcolFrames.Add clsEvents
End If
Next ctl
End Sub
Now, Frme_MouseDown will execute on MouseDown on any Frame on the form. Access the specific Frame with Frme