Userform VBA: 处理鼠标事件

Question

我正在开发 VBA UserForm（在 Excel 中），它允许用户在表单内移动标签并显示另一个表单（或我将显示的 MessageBox告诉你前面）。

仅出于这个问题的目的，这是我使用的表格：

如您所见，LABEL01 标签是表单中唯一的 control。

然后，我开始声明一些有用的变量：

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

表格由事件初始化：

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

要移动标签，我正在使用事件：

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

并显示我正在使用事件的 MessageBox：

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

一切正常，唯一的问题是，当我双击 label 调用消息框时，我引发了 MouseDown 事件，并且在关闭消息框后， MouseDown/MouseMove/MouseUp 链保持不完整：

有解决这个问题的想法吗？

Answer 1

在 MsgBox 之后，用户窗体似乎没有意识到它重新获得了焦点（并且鼠标现在位于不同的位置）。我发现的唯一解决方法是模拟鼠标单击表单。此单击应发生在保存位置，以防止任何不需要的操作（如单击按钮）。我找到的最佳位置是在表单本身的左上角。

为此，您首先需要一个模块（您不能将代码放入表格中）：

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

这会访问三个例程来获取和设置鼠标位置以及模拟鼠标事件。

现在，在表单中放置一个模拟鼠标点击的 Sub，并在调用 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

Userform VBA: 处理鼠标事件

Userform VBA: deal with mouse events

vba

mouseevent

userform