How to create a tooltip text / comments with VBA

[gmaxey]

Jason,

I'm a bit bleary eyed from looking at this stuff, but leveraging off of your idea, I think I have found a pretty interesting way of doing this.

Iv'e still not been able to keep the tip perfectly stationary, but it is close.


ThisDocument

Option Explicit

Private Sub CommandButton1_Click()
    Module1.DismissMe
    MsgBox "run me"
End Sub

Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
    ByVal X As Single, ByVal Y As Single)
    dblWidth = Me.CommandButton1.Width
    dblHeight = Me.CommandButton1.Height
    Module1.ShowMe X, Y
End Sub

UserForm1

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    'This ensures the tip is closed if the user rapidly shifts the mouse from the control to the tip.
    Unload Me
End Sub

Module1

Option Explicit

Public dblWidth As Double
Public dblHeight As Double
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetDeviceCaps Lib "Gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Const LOGPIXELSX = 88
Const LOGPIXELSY = 90

Private Declare Function GetCursorPos Lib "user32" (lngPosit As typXYPosit) As Long
    Public Type typXYPosit
        Left As Long
        Top As Long
    End Type
    Dim m_XRes As Double
    Dim m_YRes As Double

Public Function PointPerPixel_X() As Double
    Dim hDC As Long
    hDC = GetDC(0)
    PointPerPixel_X = 72 / GetDeviceCaps(hDC, LOGPIXELSX)
    m_XRes = PointPerPixel_X
    ReleaseDC 0, hDC
End Function

Public Function PointPerPixel_Y() As Double
    Dim hDC As Long
    hDC = GetDC(0)
    PointPerPixel_Y = 72 / GetDeviceCaps(hDC, LOGPIXELSY)
    m_YRes = PointPerPixel_Y
    ReleaseDC 0, hDC
End Function

Public Function MousePosit() As typXYPosit
    Dim typMousePosit As typXYPosit
    GetCursorPos typMousePosit
    MousePosit = typMousePosit
End Function

Public Function ConvertMousePositToFormPosit() As typXYPosit
    Dim typFormPosit As typXYPosit
    typFormPosit = MousePosit
    typFormPosit.Left = PointPerPixel_X * typFormPosit.Left
    typFormPosit.Top = PointPerPixel_Y * typFormPosit.Top
    ConvertMousePositToFormPosit = typFormPosit
End Function

Public Sub ShowMe(X, Y)
    'Use a band of space (like crossing a border) to trigger the form on and off.
    'Eliminates timer and flickering.
    If X > 3 And X < (dblWidth - 3) Then
        If Y > 3 And Y < (dblHeight - 3) Then
            UserForm1.Left = ConvertMousePositToFormPosit.Left + ((dblWidth + 10) / m_XRes) - X / m_XRes
            UserForm1.Top = ConvertMousePositToFormPosit.Top - Y / m_YRes
            UserForm1.Show vbModeless
        Else
            Module1.DismissMe
        End If
    Else
        Module1.DismissMe
    End If
End Sub

Public Sub DismissMe()
    Unload UserForm1
End Sub