Create Tooltip using MouseMove on ActiveX Checkbox

问题

I am trying to get a tooltip to display over an ActiveX Checkbox on my excel spreadsheet.

The below code does display and hide the tooltip but not as expected. If you move the mouse over the checkbox too quickly, the tooltip (label) will remain on the sheet.

Private Sub chkPrice_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

With sht
     If .lblTooltip.Visible = False Then
          .lblTooltip.Visible = True
     ElseIf .lblTooltip.Visible = True Then
          .lblTooltip.Visible = False
     End If
End With

To make the above code work, if there is something along the lines of:

If mousehovers for 1 second Then display the tooltip

Is there a way to check for amount of time the mouse remains on a control?

Is there another way to do this?

回答1:

There is something pretty tricky that you could do for that, so below you can find a starting point for your specific answer.

Direct answer to the question

On top of your module, you declare the Microsoft API getting the mouse coordinates:

Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Note: if you're using a 32-bit system, remove the PtrSafe keyword from the declaration. Also, on top of the module, you add this type:

Type POINTAPI
   Xcoord As Long
   Ycoord As Long
End Type

Hence, inside your macro chkPrice_MouseMove, you do something like this:

When the macro is triggered, get the mouse coordinates
Wait very shortly, say half second
Hence, get again the mouse coordinates. If they are the same than before, it means the user is keeping the mouse on the same point so you can trigger the event.

In code:

Private Sub chkPrice_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

Dim llCoordBefore As POINTAPI
Dim llCoordAfter As POINTAPI

GetCursorPos llCoordBefore '<-- get first time
Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now())+0.5)
GetCursorPos llCoordAfter '<-- get second time

If llCoordBefore.Xcoord = llCoordAfter.Xcoord And llCordBefore.Ycoord = llCoordAfter.Ycoord Then '<-- compare

    With sht
         If .lblTooltip.Visible = False Then
              .lblTooltip.Visible = True
         ElseIf .lblTooltip.Visible = True Then
              .lblTooltip.Visible = False
         End If
    End With
End If

Why I wouldn't use this

I think that your best shot is to put the ActiveX control in a place where the user doesn't hover by mistake.

Your code, on mouse hover, says that:

1) If the tooltip is not visible, then make it visible 2) If the tooltip is visible, then hide it

If the user passes quickly on the control, and the tooltip is hidden, it's expected that it will show up and don't hide. The user should pass back on the control to get it hidden again.

In any case, here are some reasons why the above method you thought about is not my recommendation:

The application will wait for X seconds. If the user hovers by mistake, he will get his Excel waiting for X seconds before he can take control again. It might be annoying in terms of UX.
The API gets the coordinates in a very sensitive way. You will need to implement an approximation (in my example, I'm proceeding only if the coordinates are exactly the same before and after hover; however, in real life, you will need to leave some margin cause the mouse might slightly move between the first and the second get of the coordinates).

回答2:

Use the Application.OnTime to hide the label 1 second after the mouse moves over the checkbox.

Public Code Module

Public TootTipVisible As Boolean
Public CheckBoxHasFocus As Boolean

Public Sub ShowTootTip()
    Application.Caption = Now 'TootTipVisible & "," & CheckBoxHasFocus
    If Not TootTipVisible And Not CheckBoxHasFocus Then
        TootTipVisible = True
        Sheet1.sht.Visible = True
        Application.OnTime Now + TimeValue("00:00:01"), "HideTootTip"
    End If
End Sub

Public Sub HideTootTip()
    TootTipVisible = False
    Sheet1.sht.Visible = False
End Sub

Worksheet Code Mode

Private Sub chkPrice_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If X > 0 And X < chkPrice.Top - chkPrice.Height Then
        ShowTootTip
        CheckBoxHasFocus = True
    Else
        CheckBoxHasFocus = False
    End If
End Sub

来源：https://stackoverflow.com/questions/51051576/create-tooltip-using-mousemove-on-activex-checkbox

标签

vba

excel-vba

tooltip

excel