Userform controls' balloon tooltips not showing in Excel 64-bit

[rplazzotta]

Can anyone help with my BalloonToolTips class? It works in Excel 32-bit (W7 and W10) but not in Windows 10 Excel 64-bit, even though it compiles without errors.
It's old VB6 code that I've adapted for VBA (VBA only exposes hWnds for Frames and Listboxes).
So I put any controls other than the above that require a multiline "ControlTipText" in a caption-less Frame with the Userform's bordercolor and I put the control's ControlTipText in that of the Frame.
It's the only way I've found to provide multiline tooltips for such controls.

But they just don't show in Excel 64-bit. Any help would be greatly appreciated.

http://www.wot.fr/BalloonToolTipDemo.zip

Richard

 

[rplazzotta]

Yes I've done the same as you. To clarify, the Tooltip's hWnd is the value returned by BalloonTip's Create() function,
and is obviously different from the control's hidden hWnd:
View attachment 51137
I'll test the Application.hInstance thing (Longptr), thanks for the tip
Richard

And I've renamed the calling code to make things clearer (replaced ctrlhWnd with TooltiphWnd).

Private Sub UserForm_Initialize()
Dim ToolTiphWnd As LongPtr '(it was LongPtr anyway)
....

And further on:
ToolTiphWnd = Tooltip.Create(Ctrl,.....

As for Application.hinstance in BalloonTooltip.cls:
it is correctly declared as either Long or LonPtr, see the #If Win64....#Else....End If section
and tthwnd (the tooltip's hwnd) is declared as LongPtr in both #If Win64 and #Else.

So I don't think that's the problem

 

[Dan_W]

And I've renamed the calling code to make things clearer (replaced ctrlhWnd with TooltiphWnd).

Private Sub UserForm_Initialize()
Dim ToolTiphWnd As LongPtr '(it was LongPtr anyway)
....

And further on:
ToolTiphWnd = Tooltip.Create(Ctrl,.....

As for Application.hinstance in BalloonTooltip.cls:
it is correctly declared as either Long or LonPtr, see the #If Win64....#Else....End If section
and tthwnd (the tooltip's hwnd) is declared as LongPtr in both #If Win64 and #Else.

So I don't think that's the problem

Re: hInstance, I did see that you had declared hInstance for the ToolInfo UDT as LongPtr, but what I meant was that I suspect that you need use Application.hInstancePtr rather than Application.hInstance (on stepping through the code, Application.hInstance returns 0)

I don't think it will solve the problem, but I do think it's one more piece of the jigsaw puzzle.

 

[rplazzotta]

Re: hInstance, I did see that you had declared hInstance for the ToolInfo UDT as LongPtr, but what I meant was that I suspect that you need use Application.hInstancePtr rather than Application.hInstance (on stepping through the code, Application.hInstance returns 0)

I don't think it will solve the problem, but I do think it's one more piece of the jigsaw puzzle.

Interesting! I wasn't aware of Application.hInstancePtr, I'll see if it makes any difference. By the way, I assume that "on stepping through the code" you are testing in Excel 64-bit, aren't you?

 

[Dan_W]

Interesting! I wasn't aware of Application.hInstancePtr, I'll see if it makes any difference. By the way, I assume that "on stepping through the code" you are testing in Excel 64-bit, aren't you?

Yes, Excel 64-bit. Fingers crossed re: hInstancePtr.
One thing I wanted to ask re the 32-bit screencaptures of the balloon tooltips, did you use different code to achieve those different styles, or was that how the different versions of Excel rendered the same code?

 

[Dan_W]

I decided to just try and build the tooltips from scratch, so I took the code from here and reworked to something simple - the create method is now triggered by the textbox mousemove event.
See screen captures below.

So it's doable. What I managed to stitch together is very hacky, though. I didn't actually implement a timer, despite what the text in the picture says. What I wasn't sure about was how the creation of the tooltips in your code is triggered, and how you time the hover time/popup time. Is that why the hwnd is required - because it is all dealt with behind the scenes?

 

[Jaafar Tribak]

@rplazzotta

Hi, I've just seen this thread.

I was unable to download the rar file even when I entered the password (today's date as directed) in YYYYMMDD format.

So, you are saying the code doesn't work in Excel 32-bit Win10 -64bit ? is that correct ?

If that's the case, then it is very likely the issue lies with the #VBA7 VS #Win64 api declares

 

[Dan_W]

Hi @Jaafar Tribak - The workbook has screen captures that indicate that the code appears to work in:
- Windows 7 32-bit, Office 2010 32-bit
- Windows 10 64-bit, Office 2019 32-bit

but does not work for Windows 10 64-bit, Office 2019 64-bit. I can confirm that the code, as posted, does not work on my system either - Windows 10 64-bit, MS 365 64-bit.

I also had difficulty downloading the workbook that had been uploaded onto the wot.fr site, but it does download without any problems from DropBox - see Post#5 (link). The password is "today's date" in YYYMMDD, and I think I tried it on 10 November, but can't be sure.

I understand that some adjustments may have been made to the code following the discussion had to-date, but I'm not sure if any of those changes were substantive.

 

[Jaafar Tribak]

I also had difficulty downloading the workbook that had been uploaded onto the wot.fr site, but it does download without any problems from DropBox - see Post#5 (link). The password is "today's date" in YYYMMDD, and I think I tried it on 10 November, but can't be sure.

No. I am still unable to extract the excel workbook.

 

[rplazzotta]

No. I am still unable to extract the excel workbook.

Hi Jaafar, Hi Dan,

Thanks for all your input.
To respond in chronological order:

Dan, the screenshots on Sheet1 reflect exaclty the same code (I've since changed ctrlhwnd to ToolTiphWnd in the USerform code, simply to clearly distinguish its hWnd from that of the Frame).
So to answer your specific question, the calling code does not use different code to achieve those different styles, it's how the different versions of Excel rendered exactly the same code.
(Bear in mind that this is very old VB6 code that I've tried to adapt for VBA).

Dan, I see you've adapted Jaafar's excellent TabTips (Ithink) code, so as you say it's doable, and I'll look at how you do it, thank you so much.

Jaafar, try the Dropbox link see Post#5 (link), with the password 20211100 (10 November).

Jaafar, I can confirm that my code works in Excel 32-bit (both Win10-64bit and Win7 32-bit) but does not work in Excel 64-bit (W10 64-bit)
But bear in mind that if Dan has successfully created tooltips directly for textboxes, my code may well be redundant, as it's based on the premise that only Frames and Listboxes expose hWnds to VBA (which is why my code puts other controls in Frames), whereas I assume that Dan's/Jaafar's code works differently.

What I'm trying to achieve is a class that can create (multiline) tooltips for all (or most of) VBA UserForm controls (as my VB6 code does for VB6 Forms, apart from Labels).

Richard

 

[Jaafar Tribak]

Take a look at this . It will probably need some further enhancement.

The CtoolTip Class exports two methods: AddTo and Remove and it allows you to set many attributes for the tooltips_class32 control.

Perhaps, I should have used class Properties to set the tooltip attributes instead of using UDTs for storage ... Ayway, see how it goes.

BTW, this works for all controls (even they don't have a hwnd) except SpinButtons and Scrollbars both of which do not expose a mousemove event. You don't need to use container frames.

Workbook Example








1- CToolTip Class Module:

Option Explicit

Private Enum eSTYLE
    TTS_ALWAYSTIP = &H1
    TTS_NOPREFIX = &H2
    TTS_NOANIMATE = &H10
    TTS_NOFADE = &H20
    TTS_BALLOON = &H40
    TTS_CLOSE = &H80
End Enum

Private Enum eICON
    TTI_NONE = 0
    TTI_INFO = 1
    TTI_WARNING = 2
    TTI_ERROR = 3
End Enum

Private Type ToolTipData
    Size As Long
    Style As eSTYLE
    BackColor As Long
    SystemInfoBackColor As Boolean 'overrides BackColor
    TextColor As Long
    SystemInfoTextColor As Boolean 'overrides TextColor
    Title As String * 64
    Icon As eICON
    Text As String * 1024
    DelayTime As Long  'in Secs
    Multiline As Boolean
    BeepSound As Boolean
End Type

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type TOOLINFO
   cbSize    As Long
   uFlags    As Long
   #If Win64 Then
        hwnd      As LongLong
        uId       As LongLong
        cRect     As RECT
        hinst     As LongLong
   #Else
        hwnd      As Long
        uId       As Long
        cRect     As RECT
        hinst     As Long
#End If
   lpszText  As String
End Type

Private Type InitCommonControlsEx
   Size As Long
   ICC As Long
End Type

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type


#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" (ByVal arg1 As LongLong, ppacc As Any, pvarChild As Variant) As Long
        Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongLong)
    #Else
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
    #End If
        Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
        Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
        Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
        Private Declare PtrSafe Function SendMessageAny Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
        Private Declare PtrSafe Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As LongPtr, ByVal hMenu As LongPtr, ByVal hInstance As LongPtr, lpParam As Any) As LongPtr
        Private Declare PtrSafe Function DestroyWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
        Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
        Private Declare PtrSafe Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal hData As LongPtr) As Long
        Private Declare PtrSafe Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
        Private Declare PtrSafe Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
        Private Declare PtrSafe Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" (ByVal Punk As stdole.IUnknown, ByRef riidEvent As GUID, ByVal fConnect As Long, ByVal PunkTarget As stdole.IUnknown, ByRef pdwCookie As Long, Optional ByVal ppcpOut As LongPtr) As Long
        Private Declare PtrSafe Function InitCommonControlsEx Lib "comctl32.dll" (iccex As InitCommonControlsEx) As Long
        Private Declare PtrSafe Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
        Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUf As LongPtr) As Long
        Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

        Private hForm As LongPtr, hToolTip As LongPtr
#Else
    Private Declare Function AccessibleObjectFromPoint Lib "oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function SendMessageAny Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
    Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
    Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    Private Declare Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" (ByVal punk As stdole.IUnknown, ByRef riidEvent As GUID, ByVal fConnect As Long, ByVal punkTarget As stdole.IUnknown, ByRef pdwCookie As Long, Optional ByVal ppcpOut As Long) As Long
    Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As InitCommonControlsEx) As Long
    Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUf As Long) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  
    Private hForm As Long, hToolTip As Long
#End If

Private WithEvents oForm As MSForms.UserForm

Private tGUID As GUID
Private oCtrl As Object
Private lCookie As Long
Private bTimedOut As Boolean
Private bNoTimedOut As Boolean

Private sText As String, sTitle As String
Private lStyle As eSTYLE, lIcon As eICON
Private lBkColor As Long, lTextColor As Long
Private bSysBkColor As Boolean, bSysTextColor As Boolean
Private lTimeOut As Long
Private bMultiline As Boolean, bBeep As Boolean



'_________________________________________Class Public Methods__________________________________________________

#If Win64 Then
    Public Sub AddTo(ByVal Ctrl As MSForms.Control, ByVal DataPtr As LongLong)
#Else
    Public Sub AddTo(ByVal Ctrl As MSForms.Control, ByVal DataPtr As Long)
#End If

    Const S_OK = 0
    Dim tTTipData As ToolTipData
  
    Set oCtrl = Ctrl
    Set oForm = GetUserFormObject(Ctrl)
    Call IUnknown_GetWindow(oForm, VarPtr(hForm))
  
    With tGUID
        .Data1 = &H20400
        .Data4(0) = &HC0
        .Data4(7) = &H46
    End With
  
    If ConnectToConnectionPoint(Me, tGUID, True, Ctrl, lCookie) = S_OK Then
        Call CopyMemory(ByVal tTTipData, ByVal DataPtr, LenB(tTTipData))
        With tTTipData
            sText = Left(.Text, InStr(1, .Text, vbNullChar) - 1)
            sTitle = Left(.Title, InStr(1, .Title, vbNullChar) - 1)
            lStyle = .Style
            lIcon = .Icon
            lBkColor = .BackColor
            lTextColor = .TextColor
            bSysBkColor = .SystemInfoBackColor
            bSysTextColor = .SystemInfoTextColor
            lTimeOut = Int(.DelayTime)
            If lTimeOut <= 0 Then bNoTimedOut = True
            bMultiline = .Multiline
            bBeep = .BeepSound
        End With
        Call CreateToolTip
    Else
          Err.Raise Number:=vbObjectError + 513, Description:="Unable to register the mouse event listener."
    End If

End Sub

Public Sub Remove()
    Call ConnectToConnectionPoint(Nothing, tGUID, False, oCtrl, lCookie)
    Call DestroyWindow(GetProp(Application.hwnd, "ToolTip"))
    Call RemoveProp(Application.hwnd, "ToolTip")
    Set oCtrl = Nothing
    Set oForm = Nothing
End Sub

Public Sub DO_NOT_USE(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    'Attribute DO_NOT_USE.VB_UserMemId = -606
    Call RetrieveControlUnderMousePointer(oCtrl)
End Sub



'__________________________________________Class Private Routines__________________________________________________

Private Sub RetrieveControlUnderMousePointer(ByVal Ctrl As MSForms.Control)

    Const CHILDID_SELF = &H0&
    Const ROLE_SYSTEM_PANE = &H10
 
    Static bDoLooping As Boolean
 
    Dim tCurPos As POINTAPI, oCurAcc As IAccessible, oPrevAcc As IAccessible
    Dim px1 As Long, py1 As Long, pw1 As Long, ph1 As Long
    Dim px2 As Long, py2 As Long, pw2 As Long, ph2 As Long
    Dim sCurAccLocation As String, sPrevAccLocation As String
    Dim t As Single
  
    t = Timer

    If bDoLooping Then Exit Sub

    Do

        If bNoTimedOut = False Then
            If Int(Timer - t) >= lTimeOut Or bTimedOut = True Then bTimedOut = True: Exit Do
        End If
 
        bDoLooping = True
        Call GetCursorPos(tCurPos)
    
        #If Win64 Then
            Dim ptr As LongLong
            Call CopyMemory(ptr, tCurPos, LenB(tCurPos))
            Call AccessibleObjectFromPoint(ptr, oCurAcc, 0&)
        #Else
            Call AccessibleObjectFromPoint(tCurPos.X, tCurPos.Y, oCurAcc, 0&)
        #End If
        
        Call oCurAcc.accLocation(px1, py1, pw1, ph1, CHILDID_SELF)
        If Not oPrevAcc Is Nothing Then
            Call oPrevAcc.accLocation(px2, py2, pw2, ph2, CHILDID_SELF)
        End If
      
        sCurAccLocation = CStr(px1) & CStr(py1) & CStr(pw1) & CStr(ph1)
        sPrevAccLocation = CStr(px2) & CStr(py2) & CStr(pw2) & CStr(ph2)
    
        If oPrevAcc Is Nothing And sCurAccLocation <> sPrevAccLocation Then
               Call UpdateToolTip(px1, py1, pw1, ph1)
        End If
      
        Set oPrevAcc = Ctrl
        Call oPrevAcc.accLocation(px2, py2, pw2, ph2, CHILDID_SELF)
        sPrevAccLocation = CStr(px2) & CStr(py2) & CStr(pw2) & CStr(ph2)

        DoEvents
    Loop Until sCurAccLocation <> sPrevAccLocation

    bDoLooping = False
  
    Call HideToolTip

End Sub

Private Function GetUserFormObject(ByVal Ctrl As MSForms.Control) As Object

    Dim oTemp As Object
 
    Set oTemp = Ctrl.Parent
    Do While TypeOf oTemp Is MSForms.Control
        Set oTemp = oTemp.Parent
        DoEvents
    Loop
    Set GetUserFormObject = oTemp
 
End Function

Private Sub CreateToolTip()

    Const WS_POPUP = &H80000000
    Const WS_EX_NOACTIVATE = &H8000000
    Const CW_USEDEFAULT = &H80000000
    Const ICC_LINK_CLASS = &H8000&
 
    Dim tIccex As InitCommonControlsEx

    If FindWindow("tooltips_class32", "MyToolTip") = 0 Then
        If hToolTip = 0 Then
            With tIccex
                .Size = LenB(tIccex)
                .ICC = ICC_LINK_CLASS
            End With
            If InitCommonControlsEx(tIccex) Then
                hToolTip = CreateWindowEx(WS_EX_NOACTIVATE, "tooltips_class32", "MyToolTip", WS_POPUP Or lStyle, _
                CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 0, 0, GetModuleHandle(vbNullString), 0)
            Else
                Err.Raise Number:=vbObjectError + 513, Description:="Unable to load common controls."
            End If
        End If
    End If
  
End Sub


Private Sub UpdateToolTip(ByVal px As Long, ByVal py As Long, ByVal pw As Long, ByVal ph As Long)

    Const WM_USER = &H400
    Const TTF_TRACK = &H20
    Const TTF_TRANSPARENT = &H100
    Const TTM_SETDELAYTIME = (WM_USER + 3)
    Const TTM_ADDTOOL = (WM_USER + 4)
    Const TTM_UPDATETIPTEXT = (WM_USER + 12)
    Const TTM_TRACKACTIVATE = (WM_USER + 17)
    Const TTM_TRACKPOSITION = (WM_USER + 18)
    Const TTM_UPDATE = (WM_USER + 29)
    Const TTM_SETTITLEA = (WM_USER + 32)
    Const TTM_SETMAXTIPWIDTH = (WM_USER + 24)
    Const TTM_SETTIPTEXTCOLOR = (WM_USER + 20)
    Const TTM_SETTIPBKCOLOR = (WM_USER + 19)
    Const COLOR_INFOBK = 24
    Const COLOR_INFOTEXT = 23
  
    Dim tToolInfo As TOOLINFO
  
    hToolTip = FindWindow("tooltips_class32", "MyToolTip")
    If hToolTip Then
        With tToolInfo
            .cbSize = LenB(tToolInfo)
            .hwnd = hForm
            .uFlags = TTF_TRACK Or TTF_TRANSPARENT
            .lpszText = sText
        End With
        Call SendMessageAny(hToolTip, TTM_SETTITLEA, lIcon, ByVal sTitle)
        Call SendMessageAny(hToolTip, TTM_ADDTOOL, 0, tToolInfo)
        Call SendMessageAny(hToolTip, TTM_TRACKACTIVATE, True, tToolInfo)
        Call SendMessageAny(hToolTip, TTM_TRACKPOSITION, ByVal 0&, ByVal MakeDWord(CInt(px + pw - 10), CInt(py + ph - 10)))
        Call SendMessage(hToolTip, TTM_SETMAXTIPWIDTH, 0&, ByVal IIf(bMultiline, 1, -1))
        Call SendMessage(hToolTip, TTM_SETTIPTEXTCOLOR, IIf(bSysTextColor, GetSysColor(COLOR_INFOTEXT), lTextColor), 0)
        Call SendMessage(hToolTip, TTM_SETTIPBKCOLOR, IIf(bSysBkColor, GetSysColor(COLOR_INFOBK), lBkColor), 0)
        Call SendMessageAny(hToolTip, TTM_UPDATETIPTEXT, 0, tToolInfo)
        Call SendMessageAny(hToolTip, TTM_UPDATE, 0, 0)
        Call SetProp(Application.hwnd, "ToolTip", hToolTip)
        If bBeep Then Beep
    End If

End Sub

Private Sub HideToolTip()
    Call ShowWindow(GetProp(Application.hwnd, "ToolTip"), 0)
End Sub

Private Function MakeDWord(loword As Integer, hiword As Integer) As Long
    MakeDWord = (hiword * &H10000) Or (loword And &HFFFF&)
End Function

Private Sub oForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    bTimedOut = False
End Sub

2- Code Usage example: (I the Userform module)

Option Explicit

Private Enum eSTYLE
    TTS_ALWAYSTIP = &H1
    TTS_NOPREFIX = &H2
    TTS_NOANIMATE = &H10
    TTS_NOFADE = &H20
    TTS_BALLOON = &H40
    TTS_CLOSE = &H80
End Enum

Private Enum eICON
    TTI_NONE = 0
    TTI_INFO = 1
    TTI_WARNING = 2
    TTI_ERROR = 3
End Enum

Private Type ToolTipData
    Size As Long
    Styles As eSTYLE
    BackColor As Long
    SystemInfoBackColor As Boolean 'overrides BackColor
    TextColor As Long
    SystemInfoTextColor As Boolean 'overrides TextColor
    Title As String * 64
    Icon As eICON
    Text As String * 1024
    DelayTime As Long  'in Seconds
    Multiline As Boolean
    BeepSound As Boolean
End Type

Private uTTData1 As ToolTipData
Private uTTData2 As ToolTipData
Private uTTData3 As ToolTipData
Private uTTData4 As ToolTipData
  
Private oCol As Collection


Private Sub UserForm_Initialize()

    Dim oCtrl As MSForms.Control
    Dim oToolTip As CToolTip
  
    Set oCol = New Collection

    'CommandButton1
    With uTTData1
        .Size = LenB(uTTData1)
        .Text = "&bla bla blah blah blah bla bla blah blah blah  ! " & vbNullChar
        .Title = CommandButton1.Name & vbNullChar
        .Styles = TTS_ALWAYSTIP + TTS_BALLOON + TTS_NOPREFIX
        .Icon = TTI_INFO
        .SystemInfoBackColor = True
        .SystemInfoTextColor = True
        .DelayTime = 4  'secs
    End With
    Set oToolTip = New CToolTip
    oCol.Add oToolTip
    Call oToolTip.AddTo(Ctrl:=CommandButton1, DataPtr:=VarPtr(uTTData1))
  
    'CommandButton2
    With uTTData2
        .Size = LenB(uTTData2)
        .Text = "Bye!" & vbNullChar
        .Title = CommandButton2.Caption & vbNullChar
        .Styles = TTS_ALWAYSTIP + TTS_NOPREFIX
        .Icon = TTI_WARNING
        .BackColor = vbCyan
        .TextColor = vbMagenta
        .DelayTime = 4
        .BeepSound = True
    End With
    Set oToolTip = New CToolTip
    oCol.Add oToolTip
    Call oToolTip.AddTo(Ctrl:=CommandButton2, DataPtr:=VarPtr(uTTData2))

    'Frame1
    With uTTData3
        .Size = LenB(uTTData3)
        .Text = String(20, "X") & vbNewLine & String(40, "X") & vbNewLine & String(50, "X") & vbNullChar
        .Title = "Testing" & vbNullChar
        .Styles = TTS_ALWAYSTIP + TTS_NOPREFIX + TTS_BALLOON
        .Icon = TTI_ERROR
        .BackColor = vbWhite
        .TextColor = vbRed
    End With
    Set oToolTip = New CToolTip
    oCol.Add oToolTip
    Call oToolTip.AddTo(Ctrl:=Frame1, DataPtr:=VarPtr(uTTData3))

    'Remaining Controls
    For Each oCtrl In Me.Controls
        If Not (oCtrl Is CommandButton1 Or oCtrl Is CommandButton2 Or oCtrl Is Frame1) Then
        With uTTData4
            .Size = LenB(uTTData4)
            .Text = oCtrl.Name & vbNullChar
            .Title = "Hello" & vbNullChar
            .Styles = TTS_ALWAYSTIP + TTS_NOPREFIX + TTS_BALLOON
            .Icon = TTI_INFO
            .SystemInfoBackColor = True
            .SystemInfoTextColor = True
            .DelayTime = 4
        End With
        Set oToolTip = New CToolTip
        oCol.Add oToolTip
        Call oToolTip.AddTo(Ctrl:=oCtrl, DataPtr:=VarPtr(uTTData4))
        Set oToolTip = New CToolTip
        End If
    Next

End Sub

Private Sub UserForm_Terminate()
    Dim i As Long
    For i = 1 To oCol.Count
        oCol.Item(i).Remove
    Next
End Sub