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.
Related
This is my first post on this forum. So far I've managed to solve every difficulty by browsing the available answers. This time I can't.
I used this example to create a self populating userform (Userform1) with some checkboxes with events defined in the way described on the example, by Creating a class module with the code to run and assigning the class sub to the checkbox.
The UserForm1 was then replicated to several case scenarios and all works fine when these userforms are called explicitly by their names (ex: UserForm1.show) but now I call the several userforms in a "for" cicle that runs through another set of checkboxes in my worksheet to decide which userforms to initialize. Each userform is stored in an object variable (UForm) through a function based on its name, and then it is initialized, and now the events of the userforms' checkboxes do not trigger!!
Sub Test()
Dim chk As Object
Dim Uform As Object
Dim strForm as String
Dim MMarray(0 To 3, 1) As String '3 so far, more to be added
MMarray(0, 0) = "Chk1": MMarray(0, 1) = "UserForm1"
MMarray(1, 0) = "Chk2": MMarray(1, 1) = "UserForm2"
MMarray(2, 0) = "Chk3": MMarray(2, 1) = "UserForm3"
MMarray(3, 0) = "Chk4": MMarray(3, 1) = "UserForm4"
' #############################
' initializing global variables defined elsewhere
iMM = 0 '
ReDim data_ini(0, 0)
ReDim data_MM_tot(0, 1)
For i = 0 To UBound(MMarray)
Set chk = ActiveSheet.Shapes(MMarray(i, 0))
If chk.OLEFormat.Object.value = 1 Then
strForm = MMarray(i, 1)
Set Uform = GetFormObjectbyName(strForm)
Uform.Show
Call Uform.repor 'this is another sub in the userform code
End If
Next i
End Sub
I assume the issue has to do with the fact that there is an ongoing procedure when the form is shown and that's why the events can't be triggered.
Is there a way to get the events to be triggered in these circumstances?
Thanks a lot for your help.
Using your example as a base, you could have a class, like so
Private WithEvents cbCustom As MSForms.CheckBox
Private strFormName As String
Public Sub Init(cbInput As MSForms.CheckBox)
Dim ctl As Control
Set cbCustom = cbInput
Set ctl = cbInput
strFormName = ctl.Parent.Name
End Sub
Private Sub cbCustom_Click()
Select Case strFormName
Case "Userform1"
Select Case cbCustom.Name
Case "Checkbox1"
Case Else
End Select
Case "Userform2"
End Select
End Sub
I used the following in my userform
Private c As New clsCustomCheckBox
Private Sub UserForm_Initialize()
c.Init Me.CheckBox1
End Sub
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
I have a Userform Control Panel that I am making for a workbook. I have a page named #1, which is for the workbook sheet #1. I also have an 'Add sheet' button that copies the #1 page and creates a #2 page.
The problem is that the code for the controls on the #1 page do not work on the newly created #2 page. And I don't know what the page #2 controls are called so I can't make code for it beforehand.
This is the Copy/Paste code that I found somewhere. Page 0 is the General settings page and page 1 is the #1 page. I have a Frame taking up the whole Multipage area so it copies the frame and everything in it and copies it.
Option Explicit
Private Sub AddProgramButton_Click()
Dim l As Double, r As Double
Dim ctl As Control
Dim PAGECOUNT As Long
MultiPage1.Pages.Add
MultiPage1.Pages(1).Controls.Copy
PAGECOUNT = MultiPage1.Pages.Count
MultiPage1.Pages("Page" & PAGECOUNT).Paste
MultiPage1.Pages("Page" & PAGECOUNT).Caption = "#" & PAGECOUNT - 1
For Each ctl In MultiPage1.Pages(1).Controls
If TypeOf ctl Is MSForms.Frame Then
l = ctl.Left
r = ctl.Top
Exit For
End If
Next
For Each ctl In MultiPage1.Pages(PAGECOUNT - 1).Controls
If TypeOf ctl Is MSForms.Frame Then
ctl.Left = l
ctl.Top = r
Exit For
End If
Next
End Sub
OK, I haven't got much information from you to go with, but I can make this work by using the following method. If you want to use it, you will have to modify it to suit your own needs.
To follow this example, you will need to create a new UserForm, preferably in a new workbook, and follow my instructions below.
I have created a UserForm as you state, with a Multipage - currently I have pages 0 and 1 on it. Page 0 I am ignoring for the purposes of this example (you mentioned it was just the General Settings page).
Seperate from the Multipage, I have put the main CommandButton (the one which actually adds the new Page when it's clicked) and have named it AddProgramButton as you did.
On Page 1, I have a frame as you state. Within this frame, I have put a CommandButton, a TextBox and a ComboBox on mine. I don't know what your controls are, but you will need to follow my example for now.
Now we need to start entering the code. First, if you haven't already got one, insert a Standard Module in your project. At the top of this standard module, enter the following code:
Option Explicit
Public myButtonArr() As New CButton
Public myComboArr() As New CCombo
Public myTextBoxArr() As New CTextBox
Now, in your UserForm module, you should input the following (note that some of this is the information you first provided):
Option Explicit
Private Sub UserForm_Initialize()
Dim ctl As Control
For Each ctl In MultiPage1.Pages(1).Controls
Select Case TypeName(ctl)
Case Is = "CommandButton"
ReDim Preserve myButtonArr(1 To 1)
Set myButtonArr(1).myButton = ctl
Case Is = "ComboBox"
ReDim Preserve myComboArr(1 To 1)
Set myComboArr(1).myCombo = ctl
ctl.AddItem "A"
ctl.AddItem "B"
Case Is = "TextBox"
ReDim Preserve myTextBoxArr(1 To 1)
Set myTextBoxArr(1).myTextBox = ctl
End Select
Next ctl
End Sub
Private Sub AddProgramButton_Click()
Dim l As Double, r As Double
Dim ctl As Control
Dim PAGECOUNT As Long
MultiPage1.Pages.Add
MultiPage1.Pages(1).Controls.Copy
PAGECOUNT = MultiPage1.Pages.Count
MultiPage1.Pages("Page" & PAGECOUNT).Paste
MultiPage1.Pages("Page" & PAGECOUNT).Caption = "#" & PAGECOUNT - 1
For Each ctl In MultiPage1.Pages(1).Controls
If TypeOf ctl Is MSForms.Frame Then
l = ctl.Left
r = ctl.Top
Exit For
End If
Next
For Each ctl In MultiPage1.Pages(PAGECOUNT - 1).Controls
If TypeOf ctl Is MSForms.Frame Then
ctl.Left = l
ctl.Top = r
Exit For
End If
Next
For Each ctl In MultiPage1.Pages(PAGECOUNT - 1).Controls
Select Case TypeName(ctl)
Case Is = "CommandButton"
ReDim Preserve myButtonArr(1 To PAGECOUNT - 1)
Set myButtonArr(PAGECOUNT - 1).myButton = ctl
Case Is = "ComboBox"
ReDim Preserve myComboArr(1 To PAGECOUNT - 1)
Set myComboArr(PAGECOUNT - 1).myCombo = ctl
ctl.AddItem "A"
ctl.AddItem "B"
Case Is = "TextBox"
ReDim Preserve myTextBoxArr(1 To PAGECOUNT - 1)
Set myTextBoxArr(PAGECOUNT - 1).myTextBox = ctl
End Select
Next ctl
End Sub
Now, for each control I have within the frame, we need to create a new Class. Insert three new Class Modules. You must name these as follows:
CButton
CCombo
CTextBox
Now open the CButton class module, and insert the following code:
Option Explicit
Public WithEvents myButton As MSForms.CommandButton
Private Sub myButton_Click()
MsgBox "You clicked the button on one of the pages"
End Sub
Next, open the CCombo class module, and insert the following code:
Option Explicit
Public WithEvents myCombo As MSForms.ComboBox
Private Sub myCombo_Change()
MsgBox "You changed the value of the ComboBox on one of the pages"
End Sub
Finally, open the CTextBox class module, and insert the following code:
Option Explicit
Public WithEvents myTextBox As MSForms.TextBox
Private Sub myTextBox_Change()
MsgBox "You changed some text in the TextBox on one of the pages"
End Sub
Now, if you test your Userform, it should work. You should hopefully be able to modify my example to match your own requirements.
Note: the events in the class module will produce an identical response regardless of which page is selected. You will have to modify the code yourself (or provide more information) to "personalise" the results.
BTW you probably found your original code here: Copy Elements From One Page To Another in Multipage with VBA in Excel.
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
On a Userform, I'm blinking a frame Off/On by toggling its visiblity. It blinks a variable number of times and then stops, but in between blinks it checks for user activity. If there has been a mouse click anywhere on the form or on any of the contained controls then the blinking stops immediately.
This is what my blinker looks like.
For i = 1 To numberOfBlinks
<blink twice>
DoEvents
If <click detected> Then Exit Sub
Next i
Everything works fine except for the <click detected> part. How do I do that from inside the loop?
Did you tried to change a global boolean variable on the mouseclick event to true (default false)?
Then try to check if this global boolean variable is true in <click detected>.
This seems to work ok, but it looks like a lot of code just to detect a mouse click. For instance, I thought it should be possible to create a Class that contains all the Form Controls, so I could detect a click on any of them in one go, without having to check on each kind of control separately. I couldn't make that work and I'm hoping somebody can improve on this.
Just to restate what this does: On a Userform, a large frame named mapFrame holds any number of other frames and labels, and all those contained frames can hold any number of other frames and labels, but that's as deep as the nesting goes. I want to start a loop, (in this case the loop blinks a control off and on, but it could be any other loop) and wait for the user to click on any of the contained Frames or Labels to signal an exit from the loop. I also want to get the name of the control that was clicked.
I took the suggestion by therealmarv and used the click to set a public Boolean which gets tested inside the loop.
In a new Class Module:
Option Explicit
Public WithEvents classLabels As msForms.Label
Private Sub classLabels_Click()
clickedControlName = "" '<== Public String
With classLabels
If .Parent.Name = "mapFrame" Or _
.Parent.Parent.Name = "mapFrame" Then
isClickDetected = True '<== Public Boolean
clickedControlName = .Name
End If
End With
End Sub
In another new Class Module:
Option Explicit
Public WithEvents classFrames As msForms.Frame
Private Sub classFrames_Click()
clickedControlName = "" '<== Public String
With classFrames
If .Name = "mapFrame" Or _
.Parent.Name = "mapFrame" Or _
.Parent.Parent.Name = "mapFrame" Then
isClickDetected = True '<== Public Boolean
clickedControlName = .Name
End If
End With
End Sub
In a Form Module:
Option Explicit
Dim frames() As New clsFrames
Dim labels() As New clsLabels
Private Sub createFrameListeners()
Dim ctl As msForms.Control
Dim frameCount as Long
For Each ctl In Me.Controls
' Debug.Print TypeName(ctl): Stop
If TypeName(ctl) = "Frame" Then
frameCount = frameCount + 1
ReDim Preserve frames(1 To frameCount)
'Create the Frame Listener objects
Set frames(frameCount).classFrames = ctl
End If
Next ctl
End Sub
Private Sub createLabelListeners()
Dim ctl As msForms.Control
Dim LabelCount as Long
For Each ctl In Me.Controls
' Debug.Print TypeName(ctl): Stop
If TypeName(ctl) = "Label" Then
LabelCount = LabelCount + 1
ReDim Preserve labels(1 To LabelCount)
'Create the Label Listener objects
Set labels(LabelCount).classLabels = ctl
End If
Next ctl
End Sub
Function blinkThisControl(ctrl As Control, ByVal blinkCount As Long)
isClickDetected = False
Dim i As Integer
For i = 1 To blinkCount
' <blink ctrl twice>
DoEvents
If isClickDetected Then Exit Function
'name of clicked control will be in clickedControlName
Next i
End Function
Private Sub userform_initialize()
Call createFrameListeners
Call createLabelListeners
' do other stuff
End Sub