Limit Cursor Movement inside a Userform

Dweeb458

Board Regular
Joined
Nov 15, 2005
Messages
52
Hello All,

I'm looking for code to limit the mouse cursor to only the boundries of a userform until the userform is closed. I have found some vb code for this as an API, but cannot seem to get the code to work.

I'm using Excel 2002, Windows XP, and the error I'm encountering is:
"Compile error, Method or Data member not found" on :GetClientRect Me.hWnd, client.

Here is the code I'm using:

Code:
Option Explicit

Private Type RECT
    left As Long
    top As Long
    right As Long
    bottom As Long
End Type
Private Type POINT
    x As Long
    y As Long
End Type

Private Declare Sub ClipCursor Lib "user32" (lpRect As Any)
Private Declare Sub GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT)
Private Declare Sub ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINT)
Private Declare Sub OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long)

Private Sub CommandButton1_Click()
'Limits the Cursor movement to within the form.
    Dim client As RECT
    Dim upperleft As POINT
    
    'Get information about our window
    GetClientRect Me.hWnd, client
    upperleft.x = client.left
    upperleft.y = client.top
    
    'Make the bottom and right the same as the top/left
    client.bottom = client.top
    client.right = client.left
    
    'Convert window coordinates to screen coordinates
    ClientToScreen Me.hWnd, upperleft
    
    'offset our rectangle
    OffsetRect client, upperleft.x, upperleft.y
    
    'limit the cursor movement
    ClipCursor client
    
End Sub

Private Sub CommandButton2_Click()
 'Releases the cursor limits
    ClipCursor ByVal 0&
End Sub

Private Sub UserForm_Activate()
    CommandButton1.Caption = "Limit Cursor Movement"
    CommandButton2.Caption = "Release Limit"
End Sub

Private Sub UserForm_Click()

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
 'Releases the cursor limits
    ClipCursor ByVal 0&
End Sub

Any help with this is much appreciated.

Thanks in advance. :-D
 
Interestingly, I modified Mark's above code to allow cursor access to the userform title bar (upperleft.y = client.top - 40) and got the same results. After dragging the userform to a new location, the cursor is released from the bounds of the userform.
 
Upvote 0

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
Interestingly, I modified Mark's above code to allow cursor access to the userform title bar (upperleft.y = client.top - 40) and got the same results. After dragging the userform to a new location, the cursor is released from the bounds of the userform.

Well spotted MrIfOnly and thanks for bringing this to our attention... For some reason the cursor clipping is freed when moving the window but the MS documentation doesn't say anything about this !

Anyway, instead of using a CBT hook like I did in post #9 , let's use a windows timer to cotiniously monitor the MsgBox location on the screen and dynamically clip the cursor based on the current location.

In a Standard Module:
Code:
Option Explicit

Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Declare PtrSafe Function ClipCursor Lib "user32" (lpRect As Any) As Long
    Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Declare PtrSafe Function GetLastActivePopup Lib "user32" (ByVal hwndOwnder As LongPtr) As LongPtr
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
    Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
    Declare Function GetLastActivePopup Lib "user32" (ByVal hwndOwnder As Long) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

Property Let Confine_Cursor_To_MsgBox(ByVal vNewValue As Boolean)
    If vNewValue Then
        SetTimer Application.hwnd, 0, 0, AddressOf TimerProc
    Else
        ClipCursor ByVal 0
        KillTimer Application.hwnd, 0
    End If
End Property

Sub TimerProc()
    Dim tMsgBoxRect As RECT
    GetWindowRect GetLastActivePopup(Application.hwnd), tMsgBoxRect
    tMsgBoxRect.Right = tMsgBoxRect.Right - 2
    ClipCursor tMsgBoxRect
End Sub


Test Demo:
Code:
Sub Test()
    Confine_Cursor_To_MsgBox = True
        MsgBox "The mouse cursor is restricted to this MsgBox."
    Confine_Cursor_To_MsgBox = False
End Sub
 
Last edited:
Upvote 0
MrIfOnly and Jaara Tribak,

Thank you so much for you help.


Jaara Tribak's code in post# 12 work perfectly when I create a new VBA. But when it try to past it in my VBA the cursor only appear to limit my userform instead of the msgbox.

The only different that I could see is that my UserForm has multiple Frame on it where as the test UserForm does not. Will this cause the code not limit the cursor in the msgbox instead?

is there any way you can modified the code to accompany for UserForm with Frame? my VBA has 5 frames to be exact.

thank you. I can not tell you guys how happy I am that this exist. I've been Googling for weeks and all of my search end in no it can not be done.
 
Upvote 0
MrIfOnly and Jaara Tribak,

Thank you so much for you help.


Jaara Tribak's code in post# 12 work perfectly when I create a new VBA. But when it try to past it in my VBA the cursor only appear to limit my userform instead of the msgbox.

The only different that I could see is that my UserForm has multiple Frame on it where as the test UserForm does not. Will this cause the code not limit the cursor in the msgbox instead?

is there any way you can modified the code to accompany for UserForm with Frame? my VBA has 5 frames to be exact.

thank you. I can not tell you guys how happy I am that this exist. I've been Googling for weeks and all of my search end in no it can not be done.

I am now confused !

Are you using a userform to call the Msgbox ? and if so, how are you calling the Msgbox ? Is it from a button on the userform ?

If you can show us the code you have, it would be helpful.
 
Last edited:
Upvote 0
This code incorporates modified code from Mark (in the userform module), Jaafar's code from post #12 (pasted into a standard module), and a modified bit of code from Deepak Saradkumar Panchal at MSDN Community Support.

It will keep the cursor within the bounds of the userform, allow access to the userform title bar, prevent the userform from being moved, call a msgbox from a commandbutton within the userform, keep the cursor with the bounds of the msgbox, and, upon exiting from the msgbox, confine the cursor to the bounds of the userform.

Code:
Option Explicit

Private Type RECT
    Left As Long
    Top As Long
    right As Long
    bottom As Long
End Type


Private Type POINT
    X As Long
    Y As Long
End Type


Private Type Position
 Left As Single
 Top As Single
End Type


Private Declare Sub ClipCursor Lib "user32" (lpRect As Any)
Private Declare Sub GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT)
Private Declare Sub ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINT)
Private Declare Sub OffsetRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long)
'Added this declaration to get userform window handle
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long


Dim client As RECT
Dim upperleft As POINT
Dim hWnd As Long


Private Sub UserForm_Activate()
    'Get Userform handle
    hWnd = FindWindow(vbNullString, Me.Caption)


    'Get information about our window
    GetClientRect hWnd, client
    upperleft.X = client.Left
    upperleft.Y = client.Top - 38
    client.bottom = client.bottom + 38


    'Convert window coordinates to screen coordinates
    ClientToScreen hWnd, upperleft


    'offset our rectangle
    OffsetRect client, upperleft.X, upperleft.Y


    'limit the cursor movement
    ClipCursor client
End Sub


Private Sub UserForm_Layout()
     Static Pos As Position


     Dim Mvd As Boolean
     
     'If the form is just being initialized, store the position
     If Pos.Left = 0 Or Pos.Top = 0 Then
         Pos.Left = Me.Left
         Pos.Top = Me.Top
         Exit Sub
     End If
     
     'Check to see if the form has been moved
     Mvd = False
     If Me.Left <> Pos.Left Then
         Me.Left = Pos.Left
         Mvd = True
     End If
     If Me.Top <> Pos.Top Then
         Me.Top = Pos.Top
         Mvd = True
     End If
     
     If Mvd Then
        'limit the cursor movement
        ClipCursor client
     End If
End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
 'Releases the cursor limits
    ClipCursor ByVal 0&
End Sub


Private Sub CommandButton1_Click()
    Confine_Cursor_To_MsgBox = True
        MsgBox "The mouse cursor is restricted to this MsgBox."
    Confine_Cursor_To_MsgBox = False
    ClipCursor client
End Sub

Regards,

CJ
 
Last edited:
Upvote 0
This code incorporates modified code from Mark (in the userform module), Jaafar's code from post #12 (pasted into a standard module), and a modified bit of code from Deepak Saradkumar Panchal at MSDN Community Support.

It will keep the cursor within the bounds of the userform, allow access to the userform title bar, prevent the userform from being moved, call a msgbox from a commandbutton within the userform, keep the cursor with the bounds of the msgbox, and, upon exiting from the msgbox, confine the cursor to the bounds of the userform.

Code:
Option Explicit

Private Type RECT
    Left As Long
    Top As Long
    right As Long
    bottom As Long
End Type


Private Type POINT
    X As Long
    Y As Long
End Type


Private Type Position
 Left As Single
 Top As Single
End Type


Private Declare Sub ClipCursor Lib "user32" (lpRect As Any)
Private Declare Sub GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT)
Private Declare Sub ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINT)
Private Declare Sub OffsetRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long)
'Added this declaration to get userform window handle
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long


Dim client As RECT
Dim upperleft As POINT
Dim hWnd As Long


Private Sub UserForm_Activate()
    'Get Userform handle
    hWnd = FindWindow(vbNullString, Me.Caption)


    'Get information about our window
    GetClientRect hWnd, client
    upperleft.X = client.Left
    upperleft.Y = client.Top - 38
    client.bottom = client.bottom + 38


    'Convert window coordinates to screen coordinates
    ClientToScreen hWnd, upperleft


    'offset our rectangle
    OffsetRect client, upperleft.X, upperleft.Y


    'limit the cursor movement
    ClipCursor client
End Sub


Private Sub UserForm_Layout()
     Static Pos As Position


     Dim Mvd As Boolean
     
     'If the form is just being initialized, store the position
     If Pos.Left = 0 Or Pos.Top = 0 Then
         Pos.Left = Me.Left
         Pos.Top = Me.Top
         Exit Sub
     End If
     
     'Check to see if the form has been moved
     Mvd = False
     If Me.Left <> Pos.Left Then
         Me.Left = Pos.Left
         Mvd = True
     End If
     If Me.Top <> Pos.Top Then
         Me.Top = Pos.Top
         Mvd = True
     End If
     
     If Mvd Then
        'limit the cursor movement
        ClipCursor client
     End If
End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
 'Releases the cursor limits
    ClipCursor ByVal 0&
End Sub


Private Sub CommandButton1_Click()
    Confine_Cursor_To_MsgBox = True
        MsgBox "The mouse cursor is restricted to this MsgBox."
    Confine_Cursor_To_MsgBox = False
    ClipCursor client
End Sub

Regards,

CJ

Thanks MrIfOnly .

I would rather not prevent the userform from being moved .. The code in the following post should work without preventing the userform from being moved and also, it contains much less code and is less scattered.
 
Last edited:
Upvote 0
The code below should confine the mouse cursor to the userform and to any MsgBox or Popup window called from the userform while still allowing form as well as msgbox to be moved by the user.

1- Code in a Standard Module:
Code:
Option Explicit

Type RECT
    Left As Long
    Top As Long
    right As Long
    bottom As Long
End Type

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Declare PtrSafe Function ClipCursor Lib "user32" (lpRect As Any) As Long
    Declare PtrSafe Function GetLastActivePopup Lib "user32" (ByVal hwndOwnder As LongPtr) As LongPtr
    Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Declare PtrSafe Function GetAncestor Lib "user32" (ByVal hwnd As LongPtr, ByVal gaFlags As Long) As LongPtr
    Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  Win64 Then
        Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
        Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
     [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
    Declare Function GetLastActivePopup Lib "user32" (ByVal hwndOwnder As Long) As Long
    Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
    Declare Function GetAncestor Lib "user32" (ByVal hwnd As Long, ByVal gaFlags As Long) As Long
    Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Declare Function GetActiveWindow Lib "user32" () As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

Const GA_ROOTOWNER = 3
Const WS_SYSMENU = &H80000
Const GWL_STYLE = (-16)

Sub Confine_Cursor_To_UserForm_And_Its_OwnedWindows()
    SetTimer Application.hwnd, 0, 0, AddressOf TimerProc
End Sub

Sub TimerProc()
    Dim tMsgBoxRect As RECT
    
    With Application
        GetWindowRect GetLastActivePopup(.hwnd), tMsgBoxRect
        With tMsgBoxRect: .right = .right - 2: .bottom = .bottom - 2: End With
        ClipCursor tMsgBoxRect
        [B][COLOR=#008000]'Reset cursor cliping and kill the timer when the userform is unloaded or if an unhandled error occurs[/COLOR][/B] [B][COLOR=#008000]![/COLOR][/B]
        If GetLastActivePopup(.hwnd) = Application.hwnd Or _
        Application.hwnd <> GetAncestor(GetActiveWindow, GA_ROOTOWNER) Or _
        (GetWindowLong(GetActiveWindow, GWL_STYLE) And WS_SYSMENU) = 0 Then
            ClipCursor ByVal 0:  KillTimer .hwnd, 0
        End If
    End With
End Sub

2- Code in the UserForm Module :
Code:
Private Sub UserForm_Initialize()
    Call Confine_Cursor_To_UserForm_And_Its_OwnedWindows
End Sub

Now, if you have a commandbutton(s) on the userform that calls a MsgBox (or any other window), the Cursor will become confined to the Msgbox .. Once the Msgbox is closed, the cursor clipping goes back to the userform.
 
Last edited:
Upvote 0
I am now confused !

Are you using a userform to call the Msgbox ? and if so, how are you calling the Msgbox ? Is it from a button on the userform ?

If you can show us the code you have, it would be helpful.


Hello Jaara Tribak,
my VBA has 5 Frames that is placed over most of the middle of the Userform.
i put the code "Confine_Cursor_To_MsgBox" True and False between my MsgBox in a button. this button is place on bottom of my Userform. (i also notice i have mulitple Userform in my VBA and the one i am using is not UserForm1. is this where my problem is?).

this is the code in my button:
Confine_Cursor_To_MsgBox = True
SearchOrTransfer = MsgBox("Click ""Yes"" to search for RxE Note." & vbCr & vbCr & "Click ""No"" to route to DCTF.", _
vbYesNo + vbSystemModal, "Search Note or Transfer?")
Confine_Cursor_To_MsgBox = False


i put your Standard Module code in popst# 12 in my Module6.

i hope this explaim my issue.
 
Upvote 0
This code incorporates modified code from Mark (in the userform module), Jaafar's code from post #12 (pasted into a standard module), and a modified bit of code from Deepak Saradkumar Panchal at MSDN Community Support.

It will keep the cursor within the bounds of the userform, allow access to the userform title bar, prevent the userform from being moved, call a msgbox from a commandbutton within the userform, keep the cursor with the bounds of the msgbox, and, upon exiting from the msgbox, confine the cursor to the bounds of the userform.

Code:
Option Explicit

Private Type RECT
    Left As Long
    Top As Long
    right As Long
    bottom As Long
End Type


Private Type POINT
    X As Long
    Y As Long
End Type


Private Type Position
 Left As Single
 Top As Single
End Type


Private Declare Sub ClipCursor Lib "user32" (lpRect As Any)
Private Declare Sub GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT)
Private Declare Sub ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINT)
Private Declare Sub OffsetRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long)
'Added this declaration to get userform window handle
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long


Dim client As RECT
Dim upperleft As POINT
Dim hWnd As Long


Private Sub UserForm_Activate()
    'Get Userform handle
    hWnd = FindWindow(vbNullString, Me.Caption)


    'Get information about our window
    GetClientRect hWnd, client
    upperleft.X = client.Left
    upperleft.Y = client.Top - 38
    client.bottom = client.bottom + 38


    'Convert window coordinates to screen coordinates
    ClientToScreen hWnd, upperleft


    'offset our rectangle
    OffsetRect client, upperleft.X, upperleft.Y


    'limit the cursor movement
    ClipCursor client
End Sub


Private Sub UserForm_Layout()
     Static Pos As Position


     Dim Mvd As Boolean
     
     'If the form is just being initialized, store the position
     If Pos.Left = 0 Or Pos.Top = 0 Then
         Pos.Left = Me.Left
         Pos.Top = Me.Top
         Exit Sub
     End If
     
     'Check to see if the form has been moved
     Mvd = False
     If Me.Left <> Pos.Left Then
         Me.Left = Pos.Left
         Mvd = True
     End If
     If Me.Top <> Pos.Top Then
         Me.Top = Pos.Top
         Mvd = True
     End If
     
     If Mvd Then
        'limit the cursor movement
        ClipCursor client
     End If
End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
 'Releases the cursor limits
    ClipCursor ByVal 0&
End Sub


Private Sub CommandButton1_Click()
    Confine_Cursor_To_MsgBox = True
        MsgBox "The mouse cursor is restricted to this MsgBox."
    Confine_Cursor_To_MsgBox = False
    ClipCursor client
End Sub

Regards,

CJ

Hello CJ,
i put your code in post#15 in a new worksheet under UserForm1.
i create a button for CommandButton1_Click.
when i run the VBA, the cursor did limit within the UserForm1, however when i click on the button on the UserFrom1 i got a "Compile error: variable not defined" and then "Private Sub CommandButton1_Click()" is highlight in yellow in the edit mode.
can you tell me what i did wrong?
thanks.
 
Upvote 0
@Jaafar Tribak
your code in post#17 is what i really need but when i tried to put in my VBA it does not work.

my userform is name ScreeningNoteGenerator if that make any differnt.

plus i also need the userform to be move freely.
thank you so much for both of your help.
 
Upvote 0

Forum statistics

Threads
1,223,712
Messages
6,174,031
Members
452,542
Latest member
Bricklin

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