VBA鼠标悬停显示子窗体优化：解决未离开时窗体闪烁问题

你的问题核心在于用Application.OnTime定时关闭的方式，会在鼠标在Label上移动时反复触发窗体的显示和关闭指令，导致闪烁。最靠谱的替代方案是用Windows API的TrackMouseEvent来精准检测鼠标离开Label的事件，只有当鼠标真正离开控件时才关闭信息窗体，彻底避免不必要的重复操作。

具体实现步骤 #

1. 更新类模块代码 #

首先在类模块顶部添加API声明和必要的变量，然后修改MouseMove事件逻辑，加入鼠标离开的监控：

' 类模块顶部添加API声明和变量
Private Declare PtrSafe Function TrackMouseEvent Lib "user32" (lpEventTrack As TRACKMOUSEEVENT) As LongPtr

Private Type TRACKMOUSEEVENT
    cbSize As Long
    dwFlags As Long
    hwndTrack As LongPtr
    dwHoverTime As Long
End Type

Private Const TME_LEAVE = &H2
Private isInfoFormShown As Boolean ' 标记信息窗体是否已显示

Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim m As Variant
    Dim tme As TRACKMOUSEEVENT
    
    On Error Resume Next
    
    ' 如果是编辑模式，处理悬停显示信息
    If LabelBase.Edit.Caption = "Edit" Then
        ' 只有当信息窗体未显示，或者当前显示的不是对应Label的信息时才更新并显示
        If Not isInfoFormShown Or CurrentJob.Caption <> "Current Job of " & Label1.Caption Then
            With CurrentJob
                .Caption = "Current Job of " & Label1.Caption
                .LBcurr.List = openJobs
                .LLast = LastJob
                .LClsd = WorksheetFunction.CountIfs(oprecord.Range("e:e"), Label1.Caption, oprecord.Range("f:f"), Date, oprecord.Range("s:s"), "CLOSED")
                .LAc = Fix(Right(Label1.Tag, Len(Label1.Tag) - 1) / 24) + 70006
                m = WorksheetFunction.VLookup(Label1.Caption, rooster.Range("b:e"), 4, 0)
                .LSkill = Right(m, Len(m) - InStr(1, m, " "))
                .StartUpPosition = 0
                ' 调整信息窗体位置，相对于当前鼠标位置
                .Top = Label1.Parent.Top + Label1.Top + Y + 10
                .Left = Label1.Parent.Left + Label1.Left + X + 10
                .Show vbModeless ' 用无模式显示，不阻塞主窗体
            End With
            isInfoFormShown = True
        End If
        
        ' 启动鼠标离开监控
        tme.cbSize = Len(tme)
        tme.dwFlags = TME_LEAVE
        tme.hwndTrack = Label1.hwnd
        TrackMouseEvent tme
    ElseIf Button = XlMouseButton.xlPrimaryButton And LabelBase.Edit.Caption = "Done" Then
        ' 原有的拖动逻辑保留
        Label1.Left = Label1.Left + X - x_offset
        Label1.Top = Label1.Top + Y - y_offset
    End If
End Sub

' 处理鼠标离开Label的事件
Private Sub Label1_MouseLeave()
    ' 关闭信息窗体并重置标记
    If isInfoFormShown Then
        Unload CurrentJob
        isInfoFormShown = False
    End If
End Sub

2. 修改信息窗体代码 #

去掉原来的Application.OnTime相关逻辑，因为现在由类模块的MouseLeave事件控制关闭：

Private Sub UserForm_Activate()
    ' 移除原来的OnTime定时
End Sub

Private Sub UserForm_Terminate()
    On Error Resume Next
    With Me
        clearallcontrols
    End With
    ' 取消可能存在的定时（如果之前的代码残留）
    On Error Resume Next
    Application.OnTime Now + TimeValue("00:00:03"), "closeee", , False
End Sub

关键优化点说明 #

• 精准的鼠标离开检测：TrackMouseEvent会在鼠标真正离开Label控件时触发MouseLeave事件，不会像MouseMove那样在控件内移动就反复触发，从根源避免了窗体的重复显示/关闭。
• 避免重复显示窗体：添加isInfoFormShown标记，只有当窗体未显示或者需要更新内容时才重新加载，减少不必要的窗体操作。
• 无模式显示窗体：用.Show vbModeless显示信息窗体，保证主窗体的交互不受阻塞，同时鼠标事件能正常触发。

附主窗体加载信息窗体时的截图：

内容的提问来源于stack exchange，提问作者Mahhdy