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

R

rplazzotta

New Member
Joined
Oct 28, 2021
Messages
41
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
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
 
Sort by date Sort by votes
Thanks Jaafar, it now works identically on all 3 platforms (W7, W10XL32 and W10XL64), with or without icon/title, multiliners and position OK too.
Click to expand...
Glad this worked for you in the end and thanks for the feedback.

I have updated all of the previous workbook examples.

Below is the final revised class code for future reference in case the workbook example links are broken.

Class Name: CToolTip
VBA Code: 
Option Explicit

Private Enum eTIP_POS
    BottomRight = 0
    BottomLeft = 1
    TopRight = 2
    TopLeft = 4
    MousePos = 8
End Enum

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
    cbSize 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
    BeepSound As Boolean
    Position As eTIP_POS
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 Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #Else
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    #End If
        Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
        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 Declare PtrSafe Function FrameRect Lib "user32" (ByVal hdc As LongPtr, lpRect As Rect, ByVal hBrush As LongPtr) As Long
        Private Declare PtrSafe Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As LongPtr
        Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
        Private Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As Rect) As Long
        Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
        Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long

        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 SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length 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 Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As Rect, ByVal hBrush As Long) As Long
    Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As Rect) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
    
    Private hForm As Long, hToolTip As Long
#End If

Private WithEvents oForm As MSForms.UserForm
Private bFormUnloading As Boolean
Private bNextUpdate As Boolean
Private bTimedOut As Boolean
Private bNoTimedOut As Boolean

Private tGUID As GUID, tToolInfo As ToolInfo
Private oCtrl As Object
Private lCookie As Long

Private lStyle As eSTYLE, lIcon As eICON, lPosition As eTIP_POS
Private sText As String, sTitle As String
Private lBkColor As Long, lTextColor As Long
Private bSysBkColor As Boolean, bSysTextColor As Boolean
Private lTimeOut As Long
Private 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
            bBeep = .BeepSound
            lPosition = .Position
        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()
    If FindWindow("tooltips_class32", "MyToolTip") Then
        Call ConnectToConnectionPoint(Nothing, tGUID, False, oCtrl, lCookie)
        Call DestroyWindow(GetProp(Application.hwnd, "ToolTip"))
        Call RemoveProp(Application.hwnd, "ToolTip")
    End If
    bFormUnloading = True
    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&
 
    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, CHILDID_SELF)
        #Else
            Call AccessibleObjectFromPoint(tCurPos.X, tCurPos.Y, oCurAcc, CHILDID_SELF)
        #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, tCurPos)
        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 Or bFormUnloading

    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_WIN95_CLASSES = &HFF
    Const ICC_TAB_CLASSES = &H8
    Const WM_USER = &H400
    Const TTF_TRACK = &H20
    Const TTF_TRANSPARENT = &H100
    Const TTM_ACTIVATE = (WM_USER + 1)
    Const TTM_ADDTOOL = (WM_USER + 4)

    Dim tIccex As InitCommonControlsEx
    
    If FindWindow("tooltips_class32", "MyToolTip") = 0 Then
        If hToolTip = 0 Then
            With tIccex
                .Size = LenB(tIccex)
                .ICC = ICC_TAB_CLASSES
            End With
            If InitCommonControlsEx(tIccex) Then
                hToolTip = CreateWindowEx(WS_EX_NOACTIVATE, "tooltips_class32", "MyToolTip", lStyle + WS_POPUP, _
                CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 0, 0, GetModuleHandle(vbNullString), 0)
                With tToolInfo
                    .cbSize = LenB(tToolInfo)
                    .hwnd = hForm
                    .uFlags = TTF_TRACK Or TTF_TRANSPARENT
                End With
                Call SendMessageAny(hToolTip, TTM_ADDTOOL, 0, tToolInfo)
                Call SendMessage(hToolTip, TTM_ACTIVATE, False, ByVal 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, ByRef tP As POINTAPI)

    Const WM_USER = &H400
    Const TTF_TRACK = &H20
    Const TTF_ABSOLUTE = &H80
    Const TTF_TRANSPARENT = &H100
    Const TTM_ACTIVATE = (WM_USER + 1)
    Const TTM_SETDELAYTIME = (WM_USER + 3)
    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
    Const GWL_STYLE = (-16)
 
    #If Win64 Then
        Dim hBrush As LongLong, hdc As LongLong
    #Else
        Dim hBrush As Long, hdc As Long
    #End If
    
    Dim tClientRect As Rect
    Dim X As Integer, Y As Integer
    
    hToolTip = FindWindow("tooltips_class32", "MyToolTip")
    
    If hToolTip Then
    
        Call HideToolTip
        
        Select Case lPosition
            Case BottomRight
                X = CInt(pX + pw - 5): Y = CInt(pY + ph - 5)
            Case BottomLeft
                X = CInt(pX + 5): Y = CInt(pY + ph - 5)
            Case TopRight
                X = CInt(pX + pw - 5): Y = CInt(pY + 5)
            Case TopLeft
                X = CInt(pX + 5): Y = CInt(pY + 5)
            Case MousePos
                Y = tP.Y:   X = tP.X
        End Select

        With tToolInfo
            .cbSize = LenB(tToolInfo)
            .hwnd = hForm
            .uFlags = TTF_TRACK Or TTF_TRANSPARENT
            .lpszText = sText
        End With
        
        If lStyle And TTS_BALLOON Then
            Call SetWindowLong(hToolTip, GWL_STYLE, lStyle)
        Else
            Call SetWindowLong(hToolTip, GWL_STYLE, lStyle And Not TTS_BALLOON)
        End If
        
        Call SendMessage(hToolTip, TTM_SETMAXTIPWIDTH, 0&, 5000)
        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_SETTITLEA, lIcon, ByVal sTitle)
        Call SendMessage(hToolTip, TTM_UPDATE, ByVal 0, ByVal 0)
        Call SendMessageAny(hToolTip, TTM_TRACKACTIVATE, True, tToolInfo)
        Call SendMessageAny(hToolTip, TTM_TRACKPOSITION, ByVal 0&, ByVal MakeDWord(X, Y))
        Call SendMessage(hToolTip, TTM_ACTIVATE, True, ByVal 0)

        Call GetClientRect(hToolTip, tClientRect)
        hdc = GetDC(hToolTip)
        hBrush = CreateSolidBrush(lTextColor)
        Call FrameRect(hdc, tClientRect, hBrush)
        Call DeleteObject(hBrush)
        Call ReleaseDC(hToolTip, hdc)
        Call SetProp(Application.hwnd, "ToolTip", hToolTip)
        If bBeep Then Beep
        
    End If
    
    If bNextUpdate = False Then
        bNextUpdate = True
        UpdateToolTip pX, pY, pw, ph, tP
    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)
    Const WM_USER = &H400
    Const TTM_ACTIVATE = (WM_USER + 1)
    
    Call HideToolTip
    bNextUpdate = False
    Call SendMessage(hToolTip, TTM_ACTIVATE, 0, ByVal 0)
    bTimedOut = False
End Sub
 
Upvote 0

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
Jaafar Tribak said:
Glad this worked for you in the end and thanks for the feedback.

I have updated all of the previous workbook examples.

Below is the final revised class code for future reference in case the workbook example links are broken.

Class Name: CToolTip
VBA Code: 
Option Explicit

Private Enum eTIP_POS
    BottomRight = 0
    BottomLeft = 1
    TopRight = 2
    TopLeft = 4
    MousePos = 8
End Enum

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
    cbSize 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
    BeepSound As Boolean
    Position As eTIP_POS
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 Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #Else
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    #End If
        Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
        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 Declare PtrSafe Function FrameRect Lib "user32" (ByVal hdc As LongPtr, lpRect As Rect, ByVal hBrush As LongPtr) As Long
        Private Declare PtrSafe Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As LongPtr
        Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
        Private Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As Rect) As Long
        Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
        Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long

        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 SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length 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 Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As Rect, ByVal hBrush As Long) As Long
    Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As Rect) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
  
    Private hForm As Long, hToolTip As Long
#End If

Private WithEvents oForm As MSForms.UserForm
Private bFormUnloading As Boolean
Private bNextUpdate As Boolean
Private bTimedOut As Boolean
Private bNoTimedOut As Boolean

Private tGUID As GUID, tToolInfo As ToolInfo
Private oCtrl As Object
Private lCookie As Long

Private lStyle As eSTYLE, lIcon As eICON, lPosition As eTIP_POS
Private sText As String, sTitle As String
Private lBkColor As Long, lTextColor As Long
Private bSysBkColor As Boolean, bSysTextColor As Boolean
Private lTimeOut As Long
Private 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
            bBeep = .BeepSound
            lPosition = .Position
        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()
    If FindWindow("tooltips_class32", "MyToolTip") Then
        Call ConnectToConnectionPoint(Nothing, tGUID, False, oCtrl, lCookie)
        Call DestroyWindow(GetProp(Application.hwnd, "ToolTip"))
        Call RemoveProp(Application.hwnd, "ToolTip")
    End If
    bFormUnloading = True
    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&
 
    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, CHILDID_SELF)
        #Else
            Call AccessibleObjectFromPoint(tCurPos.X, tCurPos.Y, oCurAcc, CHILDID_SELF)
        #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, tCurPos)
        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 Or bFormUnloading

    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_WIN95_CLASSES = &HFF
    Const ICC_TAB_CLASSES = &H8
    Const WM_USER = &H400
    Const TTF_TRACK = &H20
    Const TTF_TRANSPARENT = &H100
    Const TTM_ACTIVATE = (WM_USER + 1)
    Const TTM_ADDTOOL = (WM_USER + 4)

    Dim tIccex As InitCommonControlsEx
  
    If FindWindow("tooltips_class32", "MyToolTip") = 0 Then
        If hToolTip = 0 Then
            With tIccex
                .Size = LenB(tIccex)
                .ICC = ICC_TAB_CLASSES
            End With
            If InitCommonControlsEx(tIccex) Then
                hToolTip = CreateWindowEx(WS_EX_NOACTIVATE, "tooltips_class32", "MyToolTip", lStyle + WS_POPUP, _
                CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 0, 0, GetModuleHandle(vbNullString), 0)
                With tToolInfo
                    .cbSize = LenB(tToolInfo)
                    .hwnd = hForm
                    .uFlags = TTF_TRACK Or TTF_TRANSPARENT
                End With
                Call SendMessageAny(hToolTip, TTM_ADDTOOL, 0, tToolInfo)
                Call SendMessage(hToolTip, TTM_ACTIVATE, False, ByVal 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, ByRef tP As POINTAPI)

    Const WM_USER = &H400
    Const TTF_TRACK = &H20
    Const TTF_ABSOLUTE = &H80
    Const TTF_TRANSPARENT = &H100
    Const TTM_ACTIVATE = (WM_USER + 1)
    Const TTM_SETDELAYTIME = (WM_USER + 3)
    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
    Const GWL_STYLE = (-16)
 
    #If Win64 Then
        Dim hBrush As LongLong, hdc As LongLong
    #Else
        Dim hBrush As Long, hdc As Long
    #End If
  
    Dim tClientRect As Rect
    Dim X As Integer, Y As Integer
  
    hToolTip = FindWindow("tooltips_class32", "MyToolTip")
  
    If hToolTip Then
  
        Call HideToolTip
      
        Select Case lPosition
            Case BottomRight
                X = CInt(pX + pw - 5): Y = CInt(pY + ph - 5)
            Case BottomLeft
                X = CInt(pX + 5): Y = CInt(pY + ph - 5)
            Case TopRight
                X = CInt(pX + pw - 5): Y = CInt(pY + 5)
            Case TopLeft
                X = CInt(pX + 5): Y = CInt(pY + 5)
            Case MousePos
                Y = tP.Y:   X = tP.X
        End Select

        With tToolInfo
            .cbSize = LenB(tToolInfo)
            .hwnd = hForm
            .uFlags = TTF_TRACK Or TTF_TRANSPARENT
            .lpszText = sText
        End With
      
        If lStyle And TTS_BALLOON Then
            Call SetWindowLong(hToolTip, GWL_STYLE, lStyle)
        Else
            Call SetWindowLong(hToolTip, GWL_STYLE, lStyle And Not TTS_BALLOON)
        End If
      
        Call SendMessage(hToolTip, TTM_SETMAXTIPWIDTH, 0&, 5000)
        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_SETTITLEA, lIcon, ByVal sTitle)
        Call SendMessage(hToolTip, TTM_UPDATE, ByVal 0, ByVal 0)
        Call SendMessageAny(hToolTip, TTM_TRACKACTIVATE, True, tToolInfo)
        Call SendMessageAny(hToolTip, TTM_TRACKPOSITION, ByVal 0&, ByVal MakeDWord(X, Y))
        Call SendMessage(hToolTip, TTM_ACTIVATE, True, ByVal 0)

        Call GetClientRect(hToolTip, tClientRect)
        hdc = GetDC(hToolTip)
        hBrush = CreateSolidBrush(lTextColor)
        Call FrameRect(hdc, tClientRect, hBrush)
        Call DeleteObject(hBrush)
        Call ReleaseDC(hToolTip, hdc)
        Call SetProp(Application.hwnd, "ToolTip", hToolTip)
        If bBeep Then Beep
      
    End If
  
    If bNextUpdate = False Then
        bNextUpdate = True
        UpdateToolTip pX, pY, pw, ph, tP
    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)
    Const WM_USER = &H400
    Const TTM_ACTIVATE = (WM_USER + 1)
  
    Call HideToolTip
    bNextUpdate = False
    Call SendMessage(hToolTip, TTM_ACTIVATE, 0, ByVal 0)
    bTimedOut = False
End Sub
Click to expand...
Jaafar, me again. I've now added your class to my main application, which I can't really post here (.xlsb or .xlsm, 2 huge worksheets, respectively abot 110,000 and 90,000 rows, which is why I can't save it as an .xls. The .xlsb file size is about 11MB, it's a bilingual dictionary with 15 standard modules and 8 userforms).

CreateToolTip now doesn't work, no error, but FindWindow("tooltips_class32", "MyToolTip") always returns a value greater than zero.

So I've tried modifying the Findwindow part of the code as follows:

VBA Code: 
Private Sub CreateToolTip()
    '.....
    Dim FW As LongPtr
    FW = FindWindow("tooltips_class32", "MyToolTip")
    Debug.Print FW ' always > 0 in the xlsb and the xlsm, on all 3 platforms!
                                  'If FindWindow("tooltips_class32", "MyToolTip") = 0 Then
    If FindWindow("tooltips_class32", "MyToolTip") <> 0 Then
        If hToolTip = 0 Then 'I've also tried hToolTip <> 0, no difference
            With tIccex
               '...
               'the rest of the function completes without error, but the tooltips don't show

And this is true on all my 3 platforms, so I don't think it's a 32/64-bit issue.
I don't want to mess around any more with your code.
The only thing I can think of is that it's a workbook with 2 or more userforms (I've only tested 2 so far), because your workbook only has one.

Any ideas?
What exactly are "tooltips_class32" and "MyToolTip"?

Richard
 
Upvote 0
It is not a 32/64bit issue as you said. It is because the code was initially conceived for a single userform.
Fortunately, it is not difficult to modify the class code to make it work for multiple userforms if we pass the userform handle as a unique ID for the tooltip.

EDITED: I will post the code and workbook example in the next post.
 
Upvote 0



Class for Multiple UserForms Workbook Example


CToolTip Class
Code: 
Option Explicit

Private Enum eTIP_POS
    BottomRight = 0
    BottomLeft = 1
    TopRight = 2
    TopLeft = 4
    MousePos = 8
End Enum

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
    cbSize 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
    BeepSound As Boolean
    Position As eTIP_POS
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 Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #Else
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    #End If
        Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
        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 Declare PtrSafe Function FrameRect Lib "user32" (ByVal hdc As LongPtr, lpRect As Rect, ByVal hBrush As LongPtr) As Long
        Private Declare PtrSafe Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As LongPtr
        Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
        Private Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As Rect) As Long
        Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
        Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
        Private Declare PtrSafe Function TranslateColor Lib "oleAut32.dll" Alias "OleTranslateColor" (ByVal clr As OLE_COLOR, ByVal palet As LongPtr, Col As Long) As Long

        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 SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length 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 Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As Rect, ByVal hBrush As Long) As Long
    Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As Rect) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
    Private Declare Function TranslateColor Lib "oleAut32.dll" Alias "OleTranslateColor" (ByVal clr As OLE_COLOR, ByVal palet As Long, Col As Long) As Long
    
    Private hForm As Long, hToolTip As Long
#End If

Private WithEvents oForm As MSForms.UserForm
Private bFormUnloading As Boolean
Private bNextUpdate As Boolean
Private bTimedOut As Boolean
Private bNoTimedOut As Boolean

Private tGUID As GUID, tToolInfo As ToolInfo
Private oCtrl As Object
Private lCookie As Long

Private lStyle As eSTYLE, lIcon As eICON, lPosition As eTIP_POS
Private sText As String, sTitle As String
Private lBkColor As Long, lTextColor As Long
Private bSysBkColor As Boolean, bSysTextColor As Boolean
Private lTimeOut As Long
Private 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
            Call TranslateColor(.BackColor, 0, lBkColor)
            lTextColor = .TextColor
            bSysBkColor = .SystemInfoBackColor
            bSysTextColor = .SystemInfoTextColor
            lTimeOut = Int(.DelayTime)
            If lTimeOut <= 0 Then bNoTimedOut = True
            bBeep = .BeepSound
            lPosition = .Position
        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()
    If FindWindow("tooltips_class32", CStr(hForm)) Then
        Call ConnectToConnectionPoint(Nothing, tGUID, False, oCtrl, lCookie)
        Call DestroyWindow(GetProp(Application.hwnd, CStr(hForm) & "ToolTip"))
        Call RemoveProp(Application.hwnd, CStr(hForm) & "ToolTip")
    End If
    bFormUnloading = True
    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&
 
    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, CHILDID_SELF)
        #Else
            Call AccessibleObjectFromPoint(tCurPos.X, tCurPos.Y, oCurAcc, CHILDID_SELF)
        #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, tCurPos)
        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 Or bFormUnloading

    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_WIN95_CLASSES = &HFF
    Const ICC_TAB_CLASSES = &H8
    Const WM_USER = &H400
    Const TTF_TRACK = &H20
    Const TTF_TRANSPARENT = &H100
    Const TTM_ACTIVATE = (WM_USER + 1)
    Const TTM_ADDTOOL = (WM_USER + 4)

    Dim tIccex As InitCommonControlsEx
    
    If FindWindow("tooltips_class32", CStr(hForm)) = 0 Then
        If hToolTip = 0 Then
            With tIccex
                .Size = LenB(tIccex)
                .ICC = ICC_TAB_CLASSES
            End With
            If InitCommonControlsEx(tIccex) Then
                hToolTip = CreateWindowEx(WS_EX_NOACTIVATE, "tooltips_class32", CStr(hForm), lStyle + WS_POPUP, _
                CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 0, 0, GetModuleHandle(vbNullString), 0)
                With tToolInfo
                    .cbSize = LenB(tToolInfo)
                    .hwnd = hForm
                    .uFlags = TTF_TRACK Or TTF_TRANSPARENT
                End With
                Call SendMessageAny(hToolTip, TTM_ADDTOOL, 0, tToolInfo)
                Call SendMessage(hToolTip, TTM_ACTIVATE, False, ByVal 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, ByRef tP As POINTAPI)

    Const WM_USER = &H400
    Const TTF_TRACK = &H20
    Const TTF_ABSOLUTE = &H80
    Const TTF_TRANSPARENT = &H100
    Const TTM_ACTIVATE = (WM_USER + 1)
    Const TTM_SETDELAYTIME = (WM_USER + 3)
    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
    Const GWL_STYLE = (-16)
 
    #If Win64 Then
        Dim hBrush As LongLong, hdc As LongLong
    #Else
        Dim hBrush As Long, hdc As Long
    #End If
    
    Dim tClientRect As Rect
    Dim X As Integer, Y As Integer
    
    hToolTip = FindWindow("tooltips_class32", CStr(hForm))
    
    If hToolTip Then
    
        Call HideToolTip
        
        Select Case lPosition
            Case BottomRight
                X = CInt(pX + pw - 5): Y = CInt(pY + ph - 5)
            Case BottomLeft
                X = CInt(pX + 5): Y = CInt(pY + ph - 5)
            Case TopRight
                X = CInt(pX + pw - 5): Y = CInt(pY + 5)
            Case TopLeft
                X = CInt(pX + 5): Y = CInt(pY + 5)
            Case MousePos
                Y = tP.Y:   X = tP.X
        End Select

        With tToolInfo
            .cbSize = LenB(tToolInfo)
            .hwnd = hForm
            .uFlags = TTF_TRACK Or TTF_TRANSPARENT
            .lpszText = sText
        End With
        
        If lStyle And TTS_BALLOON Then
            Call SetWindowLong(hToolTip, GWL_STYLE, lStyle)
        Else
            Call SetWindowLong(hToolTip, GWL_STYLE, lStyle And Not TTS_BALLOON)
        End If
        
        Call SendMessage(hToolTip, TTM_SETMAXTIPWIDTH, 0&, 5000)
        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_SETTITLEA, lIcon, ByVal sTitle)
        Call SendMessage(hToolTip, TTM_UPDATE, ByVal 0, ByVal 0)
        Call SendMessageAny(hToolTip, TTM_TRACKACTIVATE, True, tToolInfo)
        Call SendMessageAny(hToolTip, TTM_TRACKPOSITION, ByVal 0&, ByVal MakeDWord(X, Y))
        Call SendMessage(hToolTip, TTM_ACTIVATE, True, ByVal 0)

        Call GetClientRect(hToolTip, tClientRect)
        hdc = GetDC(hToolTip)
        hBrush = CreateSolidBrush(lTextColor)
        Call FrameRect(hdc, tClientRect, hBrush)
        Call DeleteObject(hBrush)
        Call ReleaseDC(hToolTip, hdc)
        Call SetProp(Application.hwnd, CStr(hForm) & "ToolTip", hToolTip)
        If bBeep Then Beep
        
    End If
    
    If bNextUpdate = False Then
        bNextUpdate = True
        UpdateToolTip pX, pY, pw, ph, tP
    End If

End Sub

Private Sub HideToolTip()
    Call ShowWindow(GetProp(Application.hwnd, CStr(hForm) & "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)
    Const WM_USER = &H400
    Const TTM_ACTIVATE = (WM_USER + 1)
    
    Call HideToolTip
    bNextUpdate = False
    Call SendMessage(hToolTip, TTM_ACTIVATE, 0, ByVal 0)
    bTimedOut = False
End Sub
 
Upvote 0
Thanks, that's great. If you're interested, here's how I'm integrating it into my large application (see link below) .
My ControlTipText pre-processing code in UserForm1 and standard module Support_CToolTip, your code in UserForm2.

Balloons_ToolTips_MultipleUserForms.xls
 
Upvote 0
rplazzotta said:
Thanks, that's great. If you're interested, here's how I'm integrating it into my large application (see link below) .
My ControlTipText pre-processing code in UserForm1 and standard module Support_CToolTip, your code in UserForm2.

Balloons_ToolTips_MultipleUserForms.xls
Click to expand...
You have decided to store the tooltip data in the ControlTipText or Tag Properties after having encoded it in what looks like html encoded strings. IMHO, I think this would only add complexity and more work to the user when setting up the attributes of the CToolTip Class.

Also, testing your workbook, I noticed that the color of the frame around the tooltips with the TTS_BALLOON style do not display correctly (shows mixed colors) ... I have slightly amended the class code to fix this issue.

Here is your workbook with the fixed\revised code:
Balloons_ToolTips_MultipleUserForms_REVISED.xls
 
Upvote 0
Thanks for that. Re: my pseudo-html encoded variables, they are all optional (I just added them for the sake of completeness), and 95% of the tooltips in my large application are the same in style, so for me it saves a lot of time (and coding space in several userforms), all the more so as a couple of my tooltips can change depending on user preferences (e.g. the tooltip for my main Exit button leaves workbook open OR closes workbook and Excel OR closes workbook but leaves Excel open), so I can only handle them through code on start-up, updating ControlTipText with GetSetting.
I agree it may seem complex, but I've been doing something similar in VB6 for many years, so I'm comfortable with it.
It's a very personal solution for an unusually large Excel application.

Anyway, thanks for the balloon frame color fix.
 
Upvote 0
Jaafar Tribak said:
You have decided to store the tooltip data in the ControlTipText or Tag Properties after having encoded it in what looks like html encoded strings. IMHO, I think this would only add complexity and more work to the user when setting up the attributes of the CToolTip Class.

Also, testing your workbook, I noticed that the color of the frame around the tooltips with the TTS_BALLOON style do not display correctly (shows mixed colors) ... I have slightly amended the class code to fix this issue.

Here is your workbook with the fixed\revised code:
Balloons_ToolTips_MultipleUserForms_REVISED.xls
Click to expand...
I've just tested your latest revision, there are problems on my oldest platform (W7 Excel 32-bit), see image.
StickyTooltips.jpg
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question Question
"Compile Error: Out of memory" with complex userform and many vba subroutines
Replies
1
Views
483
toole123
T
J
  • Question Question
Forced to discard digital signature after opening and immediately saving an Macro-Enabled Excel file
Replies
0
Views
505
JDCreate
J
R
  • Solved
Resizing Userforms in 64-bit excel
Replies
5
Views
2K
mwoollen
M
Artik
  • Solved
Show UserForm near active cell - 64-bit version
Replies
6
Views
1K
Artik
Artik
L
  • Question Question
VBA: Dynamical Userform from Module
Replies
0
Views
881
lilcrisis
L

Forum statistics

Threads
1,223,214
Messages
6,170,771
Members
452,353
Latest member
strainu

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top