CODEWITHSUNDEEP
vbamouseeventuserform
Pspl
Pspl

Reputation: 1474

Userform VBA: deal with mouse events

I'm working on a VBA UserForm (in Excel) which allows the user to move a label inside the form and shows another form (or a MessageBox as I will show you ahead).

Just for the purposes of this question, here's the form I'm using:

enter image description here

As you can see, the LABEL01 label is the only control of the form.

Then, I start to declare some useful variables:

Public DOWN As Boolean 'To check if the mouse is down
Public OFF_X As Single 'Horizontal offset of the pointer inside the label
Public OFF_Y As Single 'Vertical offset of the pointer inside the label

The form initializes by the event:

Private Sub UserForm_Initialize()
    LABEL01.MousePointer = 5 'Mouse pointer 5 - move
End Sub

To move the label, I'm using the events:

Private Sub LABEL01_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    DOWN = True: OFF_X = X: OFF_Y = Y
End Sub
Private Sub LABEL01_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If DOWN Then
        LABEL01.Left = LABEL01.Left + X - OFF_X
        LABEL01.Top = LABEL01.Top + Y - OFF_Y
    End If
End Sub
Private Sub LABEL01_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    DOWN = False
End Sub

And to show the MessageBox I'm using the event:

Private Sub LABEL01_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    MsgBox "It's like I'm over it..."
End Sub

Everything is working fine, the only problem is, when I double click the label to call the Message Box, I'm raising the MouseDown Event and, after closing the Message Box, the MouseDown/MouseMove/MouseUp chain stays incomplete:

enter image description here

Any ideas to solve this?

Upvotes: 0

Views: 4605

Answers (1)

FunThomas
FunThomas

Reputation: 29181

After the MsgBox, the Userform seems not to be aware that it got the focus back (and the mouse is now at a different position). Only work around I found was to simulate a mouse click into the form. This click should happen at a save position to prevent any unwanted action (like a click on a button). Best position I found was at the top left corner of the Form itself.

To do so, you first need a module (you cannot put the code into the form):

Public Type POINTAPI
    X As Long
    Y As Long
End Type

Public Declare Function GetCursorPos Lib "user32" (Point As POINTAPI) As Long
Public Declare Function SetCursorPos Lib "user32" (ByVal X As Integer, ByVal Y As Integer) As Long
Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, _
                                             ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Const MOUSEEVENT_LEFTDOWN = &H2
Public Const MOUSEEVENT_LEFTUP = &H4

This accesses three routines to get and set the mouse position and to simulate a mouse event.

Now, in the form, put a Sub that simulates the mouse click and call that routine after the call to the msgBox:

Sub AdjustMouse()
    Dim mousePos As POINTAPI
    ' Save current mouse pos
    GetCursorPos mousePos

    ' "Move" the mouse to the top left corner of the form
    SetCursorPos Me.Left + 1, Me.Top + 1

    ' Simulate a MouseClick so that form gets back the focus.
    mouse_event MOUSEEVENT_LEFTDOWN, 0, 0, 0, 0
    mouse_event MOUSEEVENT_LEFTUP, 0, 0, 0, 0

    ' "Move" the mouse back to the previous position
    SetCursorPos mousePos.X, mousePos.Y
End Sub

Upvotes: 1

Related Questions