Limit Cursor Movement inside a Userform

D

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. :biggrin:
 
Sort by date Sort by votes
n07cn3 said:
@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.
Click to expand...

Using the new code from Jaafar in post 17: The name of your userform doesn't matter, nor should the number of frames within. Be sure to have the line "Call Confine_Cursor_To_UserForm_And_Its_OwnedWindows" in your UserForm_Initialize event and the rest of his code in a new standard module.

If you are still having issues, try creating a copy of your workbook, clear out all other code under the userform, and paste in Jaafar's code. If that works for you, then you can start introducing in your other code to make your userform function.
@JAAFAR: you are seriously a master of this API sh-tuff! :pray: I will be incorporating this into at least a few of my past projects. Thank-you!

Respect,

CJ
 
Upvote 0

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
@ CJ

Unfortunately, I did not create the VBA. I inherit this from previous 3 or 4 coders who is no longer with the company. I tried to do as you suggest by delete all of the codes in the UserForm and Modules but I got all kind of error that I don't know how to handle.

@JAAFAR

I like your code from post#17 the best. I wish I know how to make it compatible with my VBA. I think I found some code in one of my module that might be causing my VBA not compatible. can I post it here?
 
Upvote 0
Jaafar Tribak said:
If you just want to limit the mouse cursor to only the boundries of the MsgBox then you could use this code :

Place the following in a Standard Module :
Code: 
Option Explicit

Private 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
    Dim lHook As LongPtr

    Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
    Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
    Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    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
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Dim lHook As Long
    
    Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
    Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

Const WH_CBT = 5
Const HCBT_ACTIVATE = 5

Property Let ClipCursorToMsgBox (ByVal vNewValue As Boolean)
    If vNewValue Then
        lHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, 0, GetCurrentThreadId)
    Else
        ClipCursor ByVal 0
        UnhookWindowsHookEx lHook
    End If
End Property

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    Function HookProc(ByVal idHook As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Function HookProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

    Dim ret As Long, sClassName As String, tRect As RECT
    If idHook Then
        Select Case idHook
            Case HCBT_ACTIVATE
                sClassName = Space$(256)
                ret = GetClassName(wParam, ByVal sClassName, 256)
                sClassName = Left$(sClassName, ret)
                If sClassName = "#32770" Then
                    UnhookWindowsHookEx lHook
                    GetWindowRect wParam, tRect
                    ClipCursor tRect
                End If
        End Select
    End If
    HookProc = CallNextHookEx(lHook, idHook, wParam, ByVal lParam)
End Function


Test:
Code: 
Sub Test()
    ClipCursorToMsgBox = True
    MsgBox "The mouse cursor is restricted to this MsgBox."
    ClipCursorToMsgBox = False
End Sub
Click to expand...


Hello Jaafar and MrIfOnly,

I need a favor. Jaafar's code in post# 9 has been working great for my need at work.
However, I have recently add on a new function from Dan Elgaard for the msgbox custom button and I also need the cursor to be trap with in the message box until the user acknowledge the button. Is there anyway you guys can help me out be combine the two functions. Here is the link by Dan Elgaard for the custom button message box. http://www.excelgaard.dk/Lib/MsgBoxCB/
Basically, I need the cursor to be trap for the custom button message box (MsgBoxCB ( Message , Button Caption 1 , [ Button Caption 2 ] , [ Button Caption 3 ] , [ MsgBox Title ] , [ Icon ] ) just like the default built in VBA msgbox function.

Thank you so much for your help.
 
Upvote 0
I just tried Dan Elgaard's code in combination with Jafaar's code in post #17 and it worked seamlessly.
 
Upvote 0
@MrIfOnly

Thank you for your reply. I agree that post#17 (from @ Jaafar Tribak) work great. The cursor is released after the msgbox pop up has been acknowledge.

However, the cursor is always trapped inside the Userform.

My need for the code is not to have the cursor trap in the Userform. Is there anyway this code can be modified to work with Dan Elgaard's code and only trap the msgbox and not the userform?
 
Upvote 0
n07cn3 said:
@MrIfOnly

Thank you for your reply. I agree that post#17 (from @ Jaafar Tribak) work great. The cursor is released after the msgbox pop up has been acknowledge.

However, the cursor is always trapped inside the Userform.

My need for the code is not to have the cursor trap in the Userform. Is there anyway this code can be modified to work with Dan Elgaard's code and only trap the msgbox and not the userform?
Click to expand...

Try this :
Code: 
' (C) Dan Elgaard (www.EXCELGAARD.dk)

' MsgBox Buttons/Answers ID Constants
  Private Const MsgBox_Button_ID_OK     As Long = 1
  Private Const MsgBox_Button_ID_Cancel As Long = 2
  Private Const MsgBox_Button_ID_Abort  As Long = 3
  Private Const MsgBox_Button_ID_Retry  As Long = 4
  Private Const MsgBox_Button_ID_Ignore As Long = 5
  Private Const MsgBox_Button_ID_Yes    As Long = 6
  Private Const MsgBox_Button_ID_No     As Long = 7


' MsgBox Buttons/Answers Text Variables
  Private MsgBox_Button_Text_OK         As String
  Private MsgBox_Button_Text_Cancel     As String
  Private MsgBox_Button_Text_Abort      As String
  Private MsgBox_Button_Text_Retry      As String
  Private MsgBox_Button_Text_Ignore     As String
  Private MsgBox_Button_Text_Yes        As String
  Private MsgBox_Button_Text_No         As String


' Handle to the Hook procedure
 [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
      Private MsgBoxHookHandle          As LongPtr                                        ' 64-bit handle
 [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
      Private MsgBoxHookHandle          As Long
 [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
 
 Private Type RECT
    Left As Long
    Top As Long
    right As Long
    bottom As Long
 End Type


' Windows API functions
 [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
      Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As LongPtr
      Private Declare PtrSafe Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As LongPtr, ByVal lpString As String) As LongPtr
      Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As LongPtr, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As LongPtr) As LongPtr
      Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr
      Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
      Private Declare PtrSafe Function ClipCursor Lib "user32" (lpRect As Any) As Long


 [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
      Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
      Private Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
      Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
      Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
      Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
      Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
 [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If


Option Private Module                                                                     ' To prevent the function(s) from appearing the worksheet list of functions (it's a 'for macros only' function)
Option Explicit


  








Function MsgBoxCB(MsgBox_Text As String, Button1 As String, Optional Button2 As String, Optional Button3 As String, Optional MsgBox_Icon As Long, Optional MsgBox_Title As String) As Long


' * ' Initialize
      On Error Resume Next




' * ' Define variables
      If Button1 = vbNullString Then
            Button1 = Button2
            Button2 = vbNullString
      End If
      If Button2 = vbNullString Then
            Button2 = Button3
            Button3 = vbNullString
      End If


      Dim ButtonsToUse As Long
      ButtonsToUse = vbAbortRetryIgnore
      If Button3 = vbNullString Then ButtonsToUse = vbYesNo
      If Button2 = vbNullString Then ButtonsToUse = vbOKOnly


      Select Case MsgBox_Icon
            Case vbCritical:        ButtonsToUse = ButtonsToUse + MsgBox_Icon
            Case vbExclamation:     ButtonsToUse = ButtonsToUse + MsgBox_Icon
            Case vbInformation:     ButtonsToUse = ButtonsToUse + MsgBox_Icon
            Case vbQuestion:        ButtonsToUse = ButtonsToUse + MsgBox_Icon
      End Select


      If MsgBox_Title = vbNullString Then MsgBox_Title = " Microsoft Excel"               ' Default MsgBox title


      Dim MsgBoxAnswer As Long




' * ' Set custom buttons texts
      MsgBox_Button_Text_OK = Button1
      MsgBox_Button_Text_Cancel = vbNullString                                            ' Not used
      MsgBox_Button_Text_Abort = Button1
      MsgBox_Button_Text_Retry = Button2
      MsgBox_Button_Text_Ignore = Button3
      MsgBox_Button_Text_Yes = Button1
      MsgBox_Button_Text_No = Button2


      MsgBoxHookHandle = SetWindowsHookEx(5, AddressOf MsgBoxHook, 0, GetCurrentThreadId) ' Set MsgBox Hook




' * ' Show hooked MsgBox
      MsgBoxAnswer = MsgBox(MsgBox_Text, ButtonsToUse, MsgBox_Title)




EF: ' End of Function
      UnhookWindowsHookEx MsgBoxHookHandle                                                ' Unhook MsgBox again
      ClipCursor ByVal 0


      Select Case MsgBoxAnswer
            Case vbOK:        MsgBoxCB = 1
            Case vbCancel:    MsgBoxCB = 0                                                ' Not used
            Case vbAbort:     MsgBoxCB = 1
            Case vbRetry:     MsgBoxCB = 2
            Case vbIgnore:    MsgBoxCB = 3
            Case vbYes:       MsgBoxCB = 1
            Case vbNo:        MsgBoxCB = 2
      End Select


End Function


[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
      Private Function MsgBoxHook(ByVal LM As LongPtr, ByVal WP As LongPtr, ByVal LP As LongPtr) As LongPtr
            SetDlgItemText WP, MsgBox_Button_ID_OK, MsgBox_Button_Text_OK
            SetDlgItemText WP, MsgBox_Button_ID_Cancel, MsgBox_Button_Text_Cancel          ' Not used
            SetDlgItemText WP, MsgBox_Button_ID_Abort, MsgBox_Button_Text_Abort
            SetDlgItemText WP, MsgBox_Button_ID_Retry, MsgBox_Button_Text_Retry
            SetDlgItemText WP, MsgBox_Button_ID_Ignore, MsgBox_Button_Text_Ignore
            SetDlgItemText WP, MsgBox_Button_ID_Yes, MsgBox_Button_Text_Yes
            SetDlgItemText WP, MsgBox_Button_ID_No, MsgBox_Button_Text_No
            
            Dim tMsgBoxRect As RECT
            GetWindowRect WP, tMsgBoxRect
            With tMsgBoxRect
                .right = .right - 2: .bottom = .bottom - 2
                ClipCursor tMsgBoxRect
            End With
      End Function
 [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
      Private Function MsgBoxHook(ByVal LM As Long, ByVal WP As Long, ByVal LP As Long) As Long
            SetDlgItemText WP, MsgBox_Button_ID_OK, MsgBox_Button_Text_OK
            SetDlgItemText WP, MsgBox_Button_ID_Cancel, MsgBox_Button_Text_Cancel         ' Not used
            SetDlgItemText WP, MsgBox_Button_ID_Abort, MsgBox_Button_Text_Abort
            SetDlgItemText WP, MsgBox_Button_ID_Retry, MsgBox_Button_Text_Retry
            SetDlgItemText WP, MsgBox_Button_ID_Ignore, MsgBox_Button_Text_Ignore
            SetDlgItemText WP, MsgBox_Button_ID_Yes, MsgBox_Button_Text_Yes
            SetDlgItemText WP, MsgBox_Button_ID_No, MsgBox_Button_Text_No
      End Function
 [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
 
Upvote 0
@Jaafar Tribak

Thank you for the code in post#26. The code no long trap the cursor to the UserForm.

However, for the mgsboxCB, the cursor is trapped outside instead of inside and for the msgbox the cursor does not get trap at all.

I am sorry for not being clear on the previous request.

Can you please (if possible) make the cursor 1) NOT to trap in the UserFrom 2) trap in the msgboxCB and 3) trap in the VBA msgbox?

I've put the code above in a module and here is the code if have in my UserForm1.
Code: 
Private Sub CommandButton1_Click()
MsgBoxAnswer = MsgBoxCB("Select a month in the first quarter...", "January", "February", "March")
End Sub

Private Sub CommandButton2_Click()
MsgBox "this is a test"""
End Sub

As always thank you for you help.
 
Upvote 0
Try this :
Code: 
' (C) Dan Elgaard (www.EXCELGAARD.dk)

' MsgBox Buttons/Answers ID Constants
  Private Const MsgBox_Button_ID_OK     As Long = 1
  Private Const MsgBox_Button_ID_Cancel As Long = 2
  Private Const MsgBox_Button_ID_Abort  As Long = 3
  Private Const MsgBox_Button_ID_Retry  As Long = 4
  Private Const MsgBox_Button_ID_Ignore As Long = 5
  Private Const MsgBox_Button_ID_Yes    As Long = 6
  Private Const MsgBox_Button_ID_No     As Long = 7

' MsgBox Buttons/Answers Text Variables
  Private MsgBox_Button_Text_OK         As String
  Private MsgBox_Button_Text_Cancel     As String
  Private MsgBox_Button_Text_Abort      As String
  Private MsgBox_Button_Text_Retry      As String
  Private MsgBox_Button_Text_Ignore     As String
  Private MsgBox_Button_Text_Yes        As String
  Private MsgBox_Button_Text_No         As String

' Handle to the Hook procedure
 [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
      Private MsgBoxHookHandle          As LongPtr                                        ' 64-bit handle
      Private MsgBoxHookHandle2         As LongPtr                                        ' 64-bit handle
 [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
      Private MsgBoxHookHandle          As Long
      Private MsgBoxHookHandle2         As Long
 [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
 
 Private Type RECT
    Left As Long
    Top As Long
    right As Long
    bottom As Long
 End Type

' Windows API functions
 [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
      Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As LongPtr
      Private Declare PtrSafe Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As LongPtr, ByVal lpString As String) As LongPtr
      Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As LongPtr, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As LongPtr) As LongPtr
      Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr
      Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
      Private Declare PtrSafe Function ClipCursor Lib "user32" (lpRect As Any) As Long
      Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
 [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
      Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
      Private Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
      Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
      Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
      Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
      Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
      Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
 [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

Option Private Module                                                                     ' To prevent the function(s) from appearing the worksheet list of functions (it's a 'for macros only' function)
Option Explicit

Function MsgBoxCB(MsgBox_Text As String, Button1 As String, Optional Button2 As String, Optional Button3 As String, Optional MsgBox_Icon As Long, Optional MsgBox_Title As String) As Long

' * ' Initialize
      On Error Resume Next

' * ' Define variables
      If Button1 = vbNullString Then
            Button1 = Button2
            Button2 = vbNullString
      End If
      If Button2 = vbNullString Then
            Button2 = Button3
            Button3 = vbNullString
      End If

      Dim ButtonsToUse As Long
      ButtonsToUse = vbAbortRetryIgnore
      If Button3 = vbNullString Then ButtonsToUse = vbYesNo
      If Button2 = vbNullString Then ButtonsToUse = vbOKOnly

      Select Case MsgBox_Icon
            Case vbCritical:        ButtonsToUse = ButtonsToUse + MsgBox_Icon
            Case vbExclamation:     ButtonsToUse = ButtonsToUse + MsgBox_Icon
            Case vbInformation:     ButtonsToUse = ButtonsToUse + MsgBox_Icon
            Case vbQuestion:        ButtonsToUse = ButtonsToUse + MsgBox_Icon
      End Select

      If MsgBox_Title = vbNullString Then MsgBox_Title = " Microsoft Excel"               ' Default MsgBox title

      Dim MsgBoxAnswer As Long

' * ' Set custom buttons texts
      MsgBox_Button_Text_OK = Button1
      MsgBox_Button_Text_Cancel = vbNullString                                            ' Not used
      MsgBox_Button_Text_Abort = Button1
      MsgBox_Button_Text_Retry = Button2
      MsgBox_Button_Text_Ignore = Button3
      MsgBox_Button_Text_Yes = Button1
      MsgBox_Button_Text_No = Button2

      MsgBoxHookHandle = SetWindowsHookEx(5, AddressOf MsgBoxHook, 0, GetCurrentThreadId) ' Set MsgBox Hook

' * ' Show hooked MsgBox
      MsgBoxAnswer = MsgBox(MsgBox_Text, ButtonsToUse, MsgBox_Title)

EF: ' End of Function
      UnhookWindowsHookEx MsgBoxHookHandle                                                ' Unhook MsgBox again
      ClipCursor ByVal 0
      Select Case MsgBoxAnswer
            Case vbOK:        MsgBoxCB = 1
            Case vbCancel:    MsgBoxCB = 0                                                ' Not used
            Case vbAbort:     MsgBoxCB = 1
            Case vbRetry:     MsgBoxCB = 2
            Case vbIgnore:    MsgBoxCB = 3
            Case vbYes:       MsgBoxCB = 1
            Case vbNo:        MsgBoxCB = 2
      End Select
End Function

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
      Private Function MsgBoxHook(ByVal LM As LongPtr, ByVal WP As LongPtr, ByVal LP As LongPtr) As LongPtr
            SetDlgItemText WP, MsgBox_Button_ID_OK, MsgBox_Button_Text_OK
            SetDlgItemText WP, MsgBox_Button_ID_Cancel, MsgBox_Button_Text_Cancel          ' Not used
            SetDlgItemText WP, MsgBox_Button_ID_Abort, MsgBox_Button_Text_Abort
            SetDlgItemText WP, MsgBox_Button_ID_Retry, MsgBox_Button_Text_Retry
            SetDlgItemText WP, MsgBox_Button_ID_Ignore, MsgBox_Button_Text_Ignore
            SetDlgItemText WP, MsgBox_Button_ID_Yes, MsgBox_Button_Text_Yes
            SetDlgItemText WP, MsgBox_Button_ID_No, MsgBox_Button_Text_No
            
            Dim tMsgBoxRect As RECT, sBuffer As String * 256, ret As Long
            
            ret = GetClassName(WP, sBuffer, Len(sBuffer))
            If Left(sBuffer, ret) = "#32770" Then
                GetWindowRect WP, tMsgBoxRect
                With tMsgBoxRect
                    .right = .right - 2: .bottom = .bottom - 2
                End With
                ClipCursor tMsgBoxRect
            End If
      End Function
 [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
      Private Function MsgBoxHook(ByVal LM As Long, ByVal WP As Long, ByVal LP As Long) As Long
            SetDlgItemText WP, MsgBox_Button_ID_OK, MsgBox_Button_Text_OK
            SetDlgItemText WP, MsgBox_Button_ID_Cancel, MsgBox_Button_Text_Cancel         ' Not used
            SetDlgItemText WP, MsgBox_Button_ID_Abort, MsgBox_Button_Text_Abort
            SetDlgItemText WP, MsgBox_Button_ID_Retry, MsgBox_Button_Text_Retry
            SetDlgItemText WP, MsgBox_Button_ID_Ignore, MsgBox_Button_Text_Ignore
            SetDlgItemText WP, MsgBox_Button_ID_Yes, MsgBox_Button_Text_Yes
            SetDlgItemText WP, MsgBox_Button_ID_No, MsgBox_Button_Text_No
            
            Dim tMsgBoxRect As RECT, sBuffer As String * 256, ret As Long
            
            ret = GetClassName(WP, sBuffer, Len(sBuffer))
            If Left(sBuffer, ret) = "#32770" Then
                GetWindowRect WP, tMsgBoxRect
                With tMsgBoxRect
                    .right = .right - 2: .bottom = .bottom - 2
                End With
                ClipCursor tMsgBoxRect
            End If
      End Function
 [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

Public Property Let MsgboxClipCursor(ByVal Clip As Boolean)
    If Clip Then
          MsgBoxHookHandle2 = SetWindowsHookEx(5, AddressOf MsgBoxClipProc, 0, GetCurrentThreadId)
    Else
        ClipCursor ByVal 0
        UnhookWindowsHookEx MsgBoxHookHandle2
    End If
End Property

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
      Private Function MsgBoxClipProc(ByVal LM As LongPtr, ByVal WP As LongPtr, ByVal LP As LongPtr) As LongPtr
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
      Private Function MsgBoxClipProc(ByVal LM As Long, ByVal WP As Long, ByVal LP As Long) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
            
            Dim tMsgBoxRect As RECT, sBuffer As String * 256, ret As Long
            
            ret = GetClassName(WP, sBuffer, Len(sBuffer))
            If Left(sBuffer, ret) = "#32770" Then
                GetWindowRect WP, tMsgBoxRect
                With tMsgBoxRect
                    .right = .right - 2: .bottom = .bottom - 2
                End With
                ClipCursor tMsgBoxRect
            End If
End Function

Then this is how you call the 2 different messageboxes :

Code: 
Private Sub CommandButton1_Click()
    MsgBoxAnswer = MsgBoxCB("Select a month in the first quarter...", "January", "February", "March")
End Sub


Private Sub CommandButton2_Click()
    MsgboxClipCursor = True
    MsgBox "this is a test"""
    MsgboxClipCursor = False
End Sub
 
Last edited:
Upvote 0
@Jaafar Tribak

Thank you so much for you help. This is exactly what I needed.

I also want to said thank you for being patience with me as I learn the VBA lingo and learn how to be more specific of what I ask for my needs are.

:)
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
Chart point must move to point of click in chart
Replies
2
Views
69
tigger_na
T
A
  • Question
What is wrong with this VBA code: userForm get hand ico for pointer on hover
2
Replies
15
Views
517
RoryA
RoryA
H
  • Solved
Catching the Mouse Click Error in Modal User Form
Replies
4
Views
299
huiettcm
H
B
  • Solved
Windows APIs and VSTO Excel Add-ins
Replies
5
Views
430
Dan_W
D
B
  • Question
Autosize combobox object suddenly crashes Excel
Replies
6
Views
441
alexofrhodes
alexofrhodes

Forum statistics

Threads
1,214,846
Messages
6,121,905
Members
449,054
Latest member
luca142

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