Generic Class for detecting Mouse Enter & Leave Events on Userform Controls.

Jaafar Tribak

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
9,806
Office Version
  1. 2016
Platform
  1. Windows
The code doesn't rely entirely on the native MouseMove event. This so that it detects when the mouse leaves controls that overlap or those that are located at the edges of the userform... It also works on controls that are located inside Frames and Multipages... The Class as well as the pseudo-events are very easy to use by the userform.

Workbook Demo









1- Class Code (C_MouseEnterLeave)
VBA Code: 
Option Explicit

Private Type POINTAPI
        x As Long
        Y As Long
End Type

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" (ByVal arg1 As LongLong, ppacc As Any, pvarChild As Variant) As Long
        Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongLong)
    #Else
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
    #End If
    Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
#Else
    Private Declare Function AccessibleObjectFromPoint Lib "oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
#End If

Private WithEvents lbl As MsForms.Label
Private WithEvents txt As MsForms.TextBox
Private WithEvents cbx As MsForms.ComboBox
Private WithEvents lbx As MsForms.ListBox
Private WithEvents chx As MsForms.CheckBox
Private WithEvents opt As MsForms.OptionButton
Private WithEvents tgl As MsForms.ToggleButton
Private WithEvents frm As MsForms.Frame
Private WithEvents cbt As MsForms.CommandButton
Private WithEvents tbs As MsForms.TabStrip
Private WithEvents mlp As MsForms.MultiPage
Private WithEvents img As MsForms.Image

Private oThis  As C_MouseEnterLeave, oForm As Object




'________________________________Class Public Method__________________________________________________

Public Sub AddControl(ByVal ThisClass As C_MouseEnterLeave, ByVal Ctrl As MsForms.Control)

    Set oThis = ThisClass
    Set oForm = GetUserFormObject(Ctrl)
  
    Select Case True
        Case TypeOf Ctrl Is MsForms.Label
            Set lbl = Ctrl
        Case TypeOf Ctrl Is MsForms.TextBox
            Set txt = Ctrl
        Case TypeOf Ctrl Is MsForms.ComboBox
            Set cbx = Ctrl
        Case TypeOf Ctrl Is MsForms.ListBox
            Set lbx = Ctrl
        Case TypeOf Ctrl Is MsForms.CheckBox
            Set chx = Ctrl
        Case TypeOf Ctrl Is MsForms.OptionButton
            Set opt = Ctrl
        Case TypeOf Ctrl Is MsForms.ToggleButton
            Set tgl = Ctrl
        Case TypeOf Ctrl Is MsForms.Frame
            Set frm = Ctrl
        Case TypeOf Ctrl Is MsForms.CommandButton
            Set cbt = Ctrl
        Case TypeOf Ctrl Is MsForms.TabStrip
            Set tbs = Ctrl
        Case TypeOf Ctrl Is MsForms.MultiPage
            Set mlp = Ctrl
        Case TypeOf Ctrl Is MsForms.Image
            Set img = Ctrl
    End Select

End Sub



'________________________________Class Private Routines__________________________________________________

Private Sub GenericMouseMoveEvent(ByVal Ctrl As MsForms.Control, Optional ByVal Index As Long)

    Const CHILDID_SELF = &H0&
    Const ROLE_SYSTEM_PANE = &H10
  
    Static bDoLooping As Boolean
  
    Dim tCurPos As POINTAPI, oCurAcc As IAccessible, oPrevAcc As IAccessible
    Dim px1 As Long, py1 As Long, pw1 As Long, ph1 As Long
    Dim px2 As Long, py2 As Long, pw2 As Long, ph2 As Long
    Dim sCurAccLocation As String, sPrevAccLocation As String


    If bDoLooping Or oForm.Tag = "TaggedUserForm" Then Exit Sub
    oForm.Tag = "TaggedUserForm"
  
    Do
  
        bDoLooping = True
        Call GetCursorPos(tCurPos)
      
        #If Win64 Then
            Dim ptr As LongLong
            Call CopyMemory(ptr, tCurPos, LenB(tCurPos))
            Call AccessibleObjectFromPoint(ptr, oCurAcc, 0&)
        #Else
            Call AccessibleObjectFromPoint(tCurPos.x, tCurPos.Y, oCurAcc, 0&)
        #End If
      
        Call oCurAcc.accLocation(px1, py1, pw1, ph1, CHILDID_SELF)
        If Not oPrevAcc Is Nothing Then
            Call oPrevAcc.accLocation(px2, py2, pw2, ph2, CHILDID_SELF)
        End If
        sCurAccLocation = CStr(px1) & CStr(py1) & CStr(pw1) & CStr(ph1)
        sPrevAccLocation = CStr(px2) & CStr(py2) & CStr(pw2) & CStr(ph2)
      
        If oPrevAcc Is Nothing And sCurAccLocation <> sPrevAccLocation Then
            Call oForm.UserForm_OnControlMouseEnter(Ctrl)
        End If
        Set oPrevAcc = Ctrl
        Call oPrevAcc.accLocation(px2, py2, pw2, ph2, CHILDID_SELF)
      
        If TypeOf Ctrl Is MsForms.MultiPage And oCurAcc.accRole(0&) = ROLE_SYSTEM_PANE Then
            Set oPrevAcc = Ctrl.Pages(Ctrl.Value)
            Call oPrevAcc.accLocation(px2, py2, pw2, ph2, CHILDID_SELF)
        End If
      
        sPrevAccLocation = CStr(px2) & CStr(py2) & CStr(pw2) & CStr(ph2)
      
        DoEvents
      
    Loop Until sCurAccLocation <> sPrevAccLocation
  
    bDoLooping = False
    Call oForm.UserForm_OnControlMouseLeave(Ctrl)
    oForm.Tag = ""

End Sub

Private Function GetUserFormObject(ByVal Ctrl As MsForms.Control) As Object

    Dim oTemp As Object
  
    Set oTemp = Ctrl.Parent
    Do While TypeOf oTemp Is MsForms.Control
        Set oTemp = oTemp.Parent
        DoEvents
    Loop
    Set GetUserFormObject = oTemp
  
End Function

Private Sub lbl_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(lbl)
End Sub
Private Sub txt_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(txt)
End Sub
Private Sub cbx_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(cbx)
End Sub
Private Sub lbx_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(lbx)
End Sub
Private Sub chx_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(chx)
End Sub
Private Sub opt_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(opt)
End Sub
Private Sub tgl_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(tgl)
End Sub
Private Sub frm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(frm)
End Sub
Private Sub cbt_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(cbt)
End Sub
Private Sub tbs_MouseMove(ByVal Index As Long, ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(tbs)
End Sub
Private Sub mlp_MouseMove(ByVal Index As Long, ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(mlp, Index + 1)
End Sub
Private Sub img_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(img)
End Sub




2- Code Usage (UserForm)
VBA Code: 
Option Explicit

'Jaafar Tribak @MrExcel.com on 07/09/2020
'Class Name : C_MouseEnterLeave:
'Class Only Method : AddControl(ByVal ThisClass As C_MouseEnterLeave, ByVal Ctrl As MsForms.Control)


Private Sub UserForm_Initialize()

    Dim oClass As C_MouseEnterLeave
    Dim oCtrl As MsForms.Control
  
    For Each oCtrl In Me.Controls
        Set oClass = New C_MouseEnterLeave
        Call oClass.AddControl(ThisClass:=oClass, Ctrl:=oCtrl)
    Next

End Sub


'Pseudo-Events Handlers Must Be Declared As PUBLIC !!
'=============================================

Public Sub UserForm_OnControlMouseEnter(ByVal Ctrl As MsForms.Control)
  
    If TypeOf Ctrl Is MultiPage Then
        Debug.Print "Mouse Entered ...  (" & Ctrl.Name & ")" & Ctrl.Pages(Ctrl.Value).Name
    Else
        Debug.Print "Mouse Entered ...  (" & Ctrl.Name & ")"
    End If
  
End Sub


Public Sub UserForm_OnControlMouseLeave(ByVal Ctrl As MsForms.Control)

    If TypeOf Ctrl Is MultiPage Then
        Debug.Print "Mouse Left ...  (" & Ctrl.Name & ")" & Ctrl.Pages(Ctrl.Value).Name
    Else
        Debug.Print "Mouse Left ...  (" & Ctrl.Name & ")"
    End If

End Sub
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Sort by date Sort by votes
Nice Jafaar. That is the most well behaved MouseLeave/Enter example I have seen to date for MSForms. Not a deal breaker, but did you leave the SpinButton out on purpose? Will it also work with that control?
 
Upvote 0
dataluver said:
Nice Jafaar. That is the most well behaved MouseLeave/Enter example I have seen to date for MSForms. Not a deal breaker, but did you leave the SpinButton out on purpose? Will it also work with that control?
Click to expand...
Unlike all other standard MSForm controls, the SpinButton and ScrollButton do not have a native MouseMove event which is the event that the class is based on... This could be workedaround using a purely API based approach (one idea comes to mind is by using an API timer coupled with a few IAccessibility or IUIAutomation calls)

Thanks for the feedback.
 
Upvote 0
This is wonderful. I've been trying all kind of methods found on Internet and forums but nothing really satisfying, but this is interesting. How could I modify so that it works for Form Control or Active X on worksheet instead of on UserForm?
 
Upvote 0
Zot said:
This is wonderful. I've been trying all kind of methods found on Internet and forums but nothing really satisfying, but this is interesting. How could I modify so that it works for Form Control or Active X on worksheet instead of on UserForm?
Click to expand...
Form controls do not support mousemove event which is the event the code relies on.
ActiveX controls on worksheets do support mousemove events but running a continious loop in the back is not a good idea.. Maybe a windows timer could help but still it would have a bad impact on performance... If a better idea comes to mind, I should post some code.
 
Upvote 0
Jaafar Tribak said:
Form controls do not support mousemove event which is the event the code relies on.
ActiveX controls on worksheets do support mousemove events but running a continious loop in the back is not a good idea.. Maybe a windows timer could help but still it would have a bad impact on performance... If a better idea comes to mind, I should post some code.
Click to expand...

I see. I tried running loop and I need to click fast enough CommandButton to trigger click, else ignored ?

Not really an expert but I'd say intermediate in VBA
 
Upvote 0
This works great.

I have 1 issue with it. When I run the command "

VBA Code: 
Unload Userform

" it throws an error.

Error: Run-time error '-2147418105 (80010007)':Automation error: The callee (server [not server application]) is not available and disappeared; all connections are invalid. ... If you receive this error while working in the program, there may be a communication issue between the workstation and the server.

When I change the command to
Code: 
UserForm.hide

it works correct.

Any ideas how to slove this?
 
Upvote 0
IvoN75 said:
This works great.

I have 1 issue with it. When I run the command "

VBA Code: 
Unload Userform

" it throws an error.

Error: Run-time error '-2147418105 (80010007)':Automation error: The callee (server [not server application]) is not available and disappeared; all connections are invalid. ... If you receive this error while working in the program, there may be a communication issue between the workstation and the server.

When I change the command to
Code: 
UserForm.hide

it works correct.

Any ideas how to slove this?
Click to expand...
Thanks IvoN75 for drawing my attention to this bug.

I have done a quick debug inspection but couldn't properly prevent the error.
That said, since this is a runtime error, it could be easily handled with On Error Resume Next ... Ignoring the error doesn't seem to cause any issues.

VBA Code: 
On Error Resume Next
    Call oForm.UserForm_OnControlMouseLeave(Ctrl)
    oForm.Tag = ""
 On Error GoTo 0

Here is the updated file demo :
MouseControlEnterLeaveEvent.xls
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question Question
RUNTIME ERROR 91 for USERFORM CODE
Replies
1
Views
114
6StringJazzer
6StringJazzer
G
  • Solved
Run-Time Error 381
2
Replies
12
Views
201
Micron
M
A
  • Solved
Could not set the RowSource property. Invalid property value. Error 380
2
Replies
16
Views
267
RoryA
RoryA
A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
1K
AndyEd
A
T
  • Solved
Chart point must move to point of click in chart
Replies
2
Views
709
tigger_na
T

Forum statistics

Threads
1,224,811
Messages
6,181,080
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top