Catching the Mouse Click Error in Modal User Form

huiettcm

New Member
Joined
Feb 10, 2023
Messages
5
Office Version
  1. 365
Platform
  1. Windows
Good morning! I'll start with the the goal. I have an excel workbook for data collection. The user can enter data using a form. The user can also edit entries, which brings the data back into the form. I'd like the user to be able to open multiple forms at once. The issue is that the mouse scroll requires a Modal user form and opening multiple forms is a Modeless function. The solution is to have to 'top' form as Modal while the other forms behind are Modeless. Now I have to switch the user forms between the two states.

I have tried to sub-class the user forms using modified code found <https://www.tek-tips.com/viewthread.cfm?qid=174794...;. This didn't work because in Modal the user forms throw an error when clicked outside the form window. The activate message never gets sent. This method crashes excel. I've also tried GetWindowPos through the Windows API. This also didn't work because that's an application level function.

Currently, there is a Userform_Click() event that works. When a user clicks in the form window but outside the user form, the form is redrawn as vbModeless and vice versa. This isn't very intuitive.

Since the focusListener doesn't work, I've included that code. I'll also include the click event for good measure. There are public variables included that are not declared or set in this code. This project has a lot of code, so I won't attach the file. But the question is.....

How do I catch the error excel throws when a user clicks outside a Modal user form, so in the error handling I can redraw the user form as Modeless?

Updates from research: I think this is an critical error thrown by the application. Code is normally suspended when a user form is displayed vbModal so this code has to be in the user form, right? Maybe the sub-class method is the way to go? IDK

UserForm Code:
VBA Code:
Option Explicit

Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal index As LongPtr) As LongPtr

Private Declare PtrSafe Function GetDC Lib "user32" _
(ByVal hwnd As LongPtr) As LongPtr

Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" _
(ByVal hdc As LongPtr, ByVal nIndex As LongPtr) As LongPtr

Private Declare PtrSafe Function ReleaseDC Lib "user32" _
(ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As LongPtr

Private Declare PtrSafe Function SetWindowPos Lib "user32" ( _
    ByVal hwnd As LongPtr, _
    ByVal hWndInsertAfter As LongPtr, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal cx As Long, _
    ByVal cy As Long, _
    ByVal wFlags As Long) As Long

Private Declare PtrSafe Function FindWindow Lib "user32" _
    Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As LongPtr

Private Const HWND_TOP = 0
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2

Private Const LOGPIXELSX = 88 'Pixels/inch in X

'A point is defined as 1/72 inches
Private Const POINTS_PER_INCH As LongPtr = 72

'Access the GetCursorPos function in user32.dll
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

' GetCursorPos requires a variable declared as a custom data type
' that will hold two longs, one for x value and one for y value
Private Type POINTAPI
    X_Pos As Long
    Y_Pos As Long
End Type

Public Function PointsPerPixel() As Double
'The size of a pixel, in points
    Dim hdc As LongPtr
    Dim lDotsPerInch As LongPtr
    hdc = GetDC(0)
    lDotsPerInch = GetDeviceCaps(hdc, LOGPIXELSX)
    PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
    ReleaseDC 0, hdc
End Function

Public Sub UserForm_Initialize()

Dim ctrl As Control
Dim i
Dim fnd As Boolean
Dim nf As DE_Form

Dim w As LongPtr, h As LongPtr, p As Double, col As Long

w = GetSystemMetrics(0) ' Screen Resolution width in points
h = GetSystemMetrics(1) ' Screen Resolution height in points

'sets screen position, height, width, zoom, and scroll bars
With Me
   
    'sets width
    If CDbl(w * PointsPerPixel * 0.75) > (Me.DataEntryGroup_Label.Width + 150) Then
        .Width = Me.DataEntryGroup_Label.Width + 150
    Else
        .Width = w * PointsPerPixel * 0.75               'Userform width= Width in Resolution * DPI * %
    End If
   
    'sets height
    .Height = h * PointsPerPixel * 0.9                  'Userform height= Height in Resolution * DPI * %
   
    'sets left
    If lft = 0 Then
        lft = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
    End If
   
    'sets top
    If tp = 0 Then
        tp = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
    End If
   
    'sets position for empty forms
    .StartUpPosition = 0
    .Left = lft
    .Top = tp
   
    .Zoom = (Me.Width / Me.DataEntryGroup_Label.Width) * 95
    .ScrollBars = fmScrollBarsVertical
    .ScrollHeight = Me.DataEntryGroup_Label.Height + 25
    .ScrollWidth = Me.DataEntryGroup_Label.Width + 25
    .ScrollTop = 0
End With

'****Bunch of code assigning form dropdown options, etc.

' Set our event extender
Set focusListener = New FormFocusListener

Dim lhWnd As LongPtr
lhWnd = FindWindow("ThunderDFrame", Me.Caption)
lPrevWnd = SetWindowLongPtr(lhWnd, GWL_WNDPROC, AddressOf myWindowProc)

End Sub

Private Sub UserForm_Activate()

If Me.Tag = "Modal" Then
    EnableMouseScroll Me
End If

ConvertToWindow

End Sub

Private Sub UserForm_Click()

Dim hold As POINTAPI
Dim i
Dim nf As DE_Form

GetCursorPos hold
lft = Me.Left
tp = Me.Top

Select Case Me.Tag
Case Is = "Modeless":
   
    If hold.X_Pos > lft And _
      hold.X_Pos < (lft + Me.Width) * 2 Then
       
        For i = 1 To editcoll.Count
            If Me.Caption = editcoll(i).Caption Then
                editcoll.Remove i
                Exit For
            End If
        Next i
       
        Me.Hide
        Me.Tag = "Modal"
        editcoll.Add Me, Key:=Me.Caption
       
        Me.Show vbModal
       
        EnableMouseScroll Me
        ConvertToWindow
       
    End If
Case Is = "Modal":
   
    If hold.X_Pos < lft Or _
      hold.X_Pos > (lft + Me.Width) Then
     
        DisableMouseScroll Me
       
        For i = 1 To editcoll.Count
            If Me.Caption = editcoll(i).Caption Then
                editcoll.Remove i
                Exit For
            End If
        Next i
       
        Me.Hide
        Me.Tag = "Modeless"
        editcoll.Add Me, Key:=Me.Caption
       
        Me.Show vbModeless
       
    End If
End Select

End Sub

Private Sub focusListener_ChangeFocus(ByVal gotFocus As Boolean)
Dim tn As String, AC As Chart
If gotFocus Then
   On Error Resume Next
   
    Select Case Me.Tag
    Case Is = "Modeless":
        For i = 1 To editcoll.Count
            If Me.Caption = editcoll(i).Caption Then
                editcoll.Remove i
                Exit For
            End If
        Next i
       
        Me.Hide
        Me.Tag = "Modal"
        editcoll.Add Me, Key:=Me.Caption
       
        Me.Show vbModal
       
        EnableMouseScroll Me
        ConvertToWindow
    Case Is = "Modal":
        DisableMouseScroll Me
       
        For i = 1 To editcoll.Count
            If Me.Caption = editcoll(i).Caption Then
                editcoll.Remove i
                Exit For
            End If
        Next i
       
        Me.Hide
        Me.Tag = "Modeless"
        editcoll.Add Me, Key:=Me.Caption
       
        Me.Show vbModeless
    End Select
    On Error GoTo 0
End If
End Sub

FormFocusListener Class:
VBA Code:
Option Explicit

Public Event ChangeFocus(ByVal gotFocus As Boolean)

Public Property Let ChangeFocusMessage(ByVal gotFocus As Boolean)
    RaiseEvent ChangeFocus(gotFocus)
End Property

FocusListener Support Module:
VBA Code:
Option Explicit

#If VBA7 Then
    Public Declare PtrSafe Function FindWindow Lib "user32" _
        Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Public Declare PtrSafe Function CallWindowProc Lib "user32" _
        Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    #If Win64 Then
        Public Declare PtrSafe Function SetWindowLongPtr Lib "user32" _
            Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #Else
        Public Declare Function SetWindowLongPtr Lib "user32" _
            Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #End If
    Public lPrevWnd As LongPtr
#Else
    Public Declare Function FindWindow Lib "user32" _
        Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Public Declare Function CallWindowProc Lib "user32" _
        Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, _
                                ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Public Declare Function SetWindowLong Lib "user32" _
        Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Public lPrevWnd As Long
#End If

Private Const WM_NCACTIVATE = &H86
Private Const WM_DESTROY = &H2
Public Const GWL_WNDPROC = (-4)

Public tf As DE_Form

#If VBA7 Then
Public Function myWindowProc(ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPtr
#Else
Public Function myWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If
    ' This function intercepts window events from the CopyCurveForm and initiates
    ' a ChangeFocus event for the FormFocusListener class object.
    On Error Resume Next ' an unhandled error in message loop may crash xl so let's ignore it (normally not best practice)
        Select Case Msg
            Debug.Print Msg
            Case WM_NULL ' sent when clicked outside modal userform
               
                'tf.focusListener.ChangeFocusMessage = wParam ' TRUE if border has been activated
                'myWindowProc = CallWindowProc(lPrevWnd, hWnd, Msg, wParam, ByVal lParam)
            Case WM_DESTROY
                ' Form is closing, so remove subclassing
                #If VBA7 Then
                    'Call SetWindowLongPtr(hWnd, GWL_WNDPROC, lPrevWnd)
                #Else
                    'Call SetWindowLong(hWnd, GWL_WNDPROC, lPrevWnd)
                #End If
                'myWindowProc = 0
            Case Else
                'myWindowProc = CallWindowProc(lPrevWnd, hWnd, Msg, wParam, ByVal lParam)
        End Select
    On Error GoTo 0
End Function 'myWindowProc
 
Last edited by a moderator:

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
The issue is that the mouse scroll requires a Modal user form and opening multiple forms is a Modeless function

There are many threads in this forum addressing how to apply/handle mouse-scrolling in userforms.

Subclassing modeless userforms do make excel unstable but, there are ways around this issue by either intercepting windows messages in loops or by setting normal or rawinput windows hooks... Do a search for MouseWheel here or in google. I am sure you will find some solutions.

As an example, here is a nice solution developped by cristianbuse for trapping mousewheel activity in several userforms, both modal and modeless ... He uses a WH_MOUSE hook yet, it is suprinsingly quite stable and robust.
 
Upvote 1
Solution
There are many threads in this forum addressing how to apply/handle mouse-scrolling in userforms.

Subclassing modeless userforms do make excel unstable but, there are ways around this issue by either intercepting windows messages in loops or by setting normal or rawinput windows hooks... Do a search for MouseWheel here or in google. I am sure you will find some solutions.

As an example, here is a nice solution developped by cristianbuse for trapping mousewheel activity in several userforms, both modal and modeless ... He uses a WH_MOUSE hook yet, it is suprinsingly quite stable and robust.
The mouse scroll isn't the issue. I've got that working great. The method I use requires that the user form be displayed modally. The issue is more about interaction. I want the user to be able to open multiple forms for edit at once. That means that only the 'top' form can be modal and have the mouse. When a user form is displayed modally and a user clicks outside the form window, there's an audible sound, in my case a ding. Seems like that's some exception, idk if it's an excel application exception or a windows 'deactivate' exception. The goal is to catch that exception and have excel automatically redraw the user form modelessly.
 
Upvote 0
There are many threads in this forum addressing how to apply/handle mouse-scrolling in userforms.

Subclassing modeless userforms do make excel unstable but, there are ways around this issue by either intercepting windows messages in loops or by setting normal or rawinput windows hooks... Do a search for MouseWheel here or in google. I am sure you will find some solutions.

As an example, here is a nice solution developped by cristianbuse for trapping mousewheel activity in several userforms, both modal and modeless ... He uses a WH_MOUSE hook yet, it is suprinsingly quite stable and robust.
the update does in fact make my problem moot. Thanks again!
 
Upvote 0

Forum statistics

Threads
1,216,500
Messages
6,131,016
Members
449,615
Latest member
Nic0la

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