Always on top But ControlTipText Behind

J

John Peter

New Member
Joined
Apr 30, 2022
Messages
10
Office Version
  1. 365
Platform
  1. Windows
Hi everyone. I have this code that works perfectly as always on top for a userform. But the problem is that whenever I have a Controltiptext, it can't be on top. It is behind the userform. How to solve this problem? Thank you. In advance.

VBA Code: 
Option Explicit
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const HWND_TOP = 0
Public Const HWND_BOTTOM = 1
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const GWL_STYLE = -16
Public Const WS_SYSMENU = &H80000
#If VBA7 Then
    Public Declare PtrSafe Function SetWindowPos Lib "user32" _
        (ByVal hWnd As LongPtr, _
        ByVal hWndInsertAfter As LongPtr, _
        ByVal x As Long, _
        ByVal Y As Long, _
        ByVal cx As Long, _
        ByVal cy As Long, _
        ByVal uFlags As Long) As Long
    
    Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
        (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As LongPtr

    Public Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
        (ByVal hWnd As LongPtr, _
        ByVal nIndex As Long) As Long
    
    Public Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
        (ByVal hWnd As LongPtr, _
        ByVal nIndex As Long, _
        ByVal dwNewLong As Long) As Long

    Public Declare PtrSafe Function DrawMenuBar Lib "user32" _
        (ByVal hWnd As LongPtr) As Long

#Else
    
    Public Declare  Function SetWindowPos Lib "user32" _
        (ByVal hWnd As Long, _
        ByVal hWndInsertAfter As Long, _
        ByVal X As Long, _
        ByVal Y As Long, _
        ByVal cx As Long, _
        ByVal cy As Long, _
        ByVal uFlags As Long) As Long
    
    Public Declare  Function FindWindow Lib "user32" Alias "FindWindowA" _
        (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long

    Public Declare  Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
        (ByVal hWnd As Long, _
        ByVal nIndex As Long) As Long
    Public Declare  Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
        (ByVal hWnd As Long, _
        ByVal nIndex As Long, _
        ByVal dwNewLong As Long) As Long
    Public Declare  Function DrawMenuBar Lib "user32" _
        (ByVal hWnd As Long) As Long
#End If
Public Sub AlwaysOnTop(caption As String, Optional OnTop As Boolean = True)
    Dim hWnd As LongPtr, lResult As Long
        Dim xStype As Long
    If Val(Application.Version) >= 9 Then
        hWnd = FindWindow("ThunderDFrame", caption)
    Else
        hWnd = FindWindow("ThunderXFrame", caption)
    End If
    
       If OnTop Then
        xStype = HWND_TOPMOST
    Else
        xStype = HWND_NOTOPMOST
    End If
    
    If hWnd <> 0 Then
        lResult = SetWindowPos(hWnd, xStype, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
    Else
        MsgBox "AlwaysOnTop: userform with caption '" & caption & "' not found"
    End If
End Sub
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Sort by date Sort by votes
Either use custom tooltip or dynamically remove the HWND_TOPMOST z order everytime you hover the control(s) that has a tooltip and reset it back when leaving the control.
 
Upvote 0
Thank you my friend, @Jaafar Tribak .I tried both solutions. For the first one it is good, but it has a deficiency that it loses focus during the hover period when it's up over other windows other than excel. For the second solution; I used a label to make it visible and invisible on the MouseMove event. Is that good or do you have another solution for the custom tooltip? Thank you in advance.
Jaafar Tribak said:
Either use custom tooltip or dynamically remove the HWND_TOPMOST z order everytime you hover the control(s) that has a tooltip and reset it back when leaving the control.
Click to expand...
 
Upvote 0
Try this and see how it goes :

Here is a workbook example :
DynamicFormZorder.xlsm

Basically, what the code does is dynamically change the form's ZOrder according to where the mouse cursor is currently located... If the cursor is over a control that has a screentip, the HWND_TOPMOST zorder of the form is temporarly removed hence the screentip is shown correctly.

The code relies on the controls and userform _MouseMove event.


1- Class Module: [CBringTiptoTop]
VBA Code: 
Option Explicit

Private WithEvents lbl As MsForms.Label
Private WithEvents txt As MsForms.TextBox
Private WithEvents cbx As MsForms.ComboBox
Private WithEvents lbx As MsForms.ListBox
Private WithEvents chx As MsForms.CheckBox
Private WithEvents opt As MsForms.OptionButton
Private WithEvents tgl As MsForms.ToggleButton
Private WithEvents frm As MsForms.Frame
Private WithEvents cbt As MsForms.CommandButton
Private WithEvents tbs As MsForms.TabStrip
Private WithEvents mlp As MsForms.MultiPage
Private WithEvents img As MsForms.Image

Private oForm As UserForm

Public Sub AddControl(ByVal Form As UserForm, ByVal Ctrl As MsForms.Control)

    Set oForm = Form
    Select Case True
        Case TypeOf Ctrl Is MsForms.Label
            Set lbl = Ctrl
        Case TypeOf Ctrl Is MsForms.TextBox
            Set txt = Ctrl
        Case TypeOf Ctrl Is MsForms.ComboBox
            Set cbx = Ctrl
        Case TypeOf Ctrl Is MsForms.ListBox
            Set lbx = Ctrl
        Case TypeOf Ctrl Is MsForms.CheckBox
            Set chx = Ctrl
        Case TypeOf Ctrl Is MsForms.OptionButton
            Set opt = Ctrl
        Case TypeOf Ctrl Is MsForms.ToggleButton
            Set tgl = Ctrl
        Case TypeOf Ctrl Is MsForms.Frame
            Set frm = Ctrl
        Case TypeOf Ctrl Is MsForms.CommandButton
            Set cbt = Ctrl
        Case TypeOf Ctrl Is MsForms.TabStrip
            Set tbs = Ctrl
        Case TypeOf Ctrl Is MsForms.MultiPage
            Set mlp = Ctrl
        Case TypeOf Ctrl Is MsForms.Image
            Set img = Ctrl
    End Select

End Sub

Private Sub GenericMouseMoveEvent(ByVal Ctrl As MsForms.Control)
     MakeTopWindow oForm, False
End Sub

Private Sub lbl_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(lbl)
End Sub
Private Sub txt_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(txt)
End Sub
Private Sub cbx_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(cbx)
End Sub
Private Sub lbx_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(lbx)
End Sub
Private Sub chx_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(chx)
End Sub
Private Sub opt_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(opt)
End Sub
Private Sub tgl_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(tgl)
End Sub
Private Sub frm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(frm)
End Sub
Private Sub cbt_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(cbt)
End Sub
Private Sub tbs_MouseMove(ByVal Index As Long, ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(tbs)
End Sub
Private Sub mlp_MouseMove(ByVal Index As Long, ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(mlp)
End Sub
Private Sub img_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(img)
End Sub


2- In a Standard Module:
VBA Code: 
Option Explicit

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    #Else
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    #End If
    Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUF As LongPtr) As Long
    Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal uFlags As Long) As Long
    Private Declare PtrSafe Function GetTopWindow Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUF As LongPtr) As Long
    Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal uFlags As Long) As Long
    Private Declare Function GetTopWindow Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare Function GetActiveWindow Lib "user32" () As LongPtr
#End If


Public Sub MakeTopWindow(ByVal Form As UserForm, Optional bOnTop As Boolean = True)

    Const HWND_TOPMOST = -1&
    Const HWND_NOTOPMOST = -2&
    Const SWP_NOMOVE = &H2
    Const SWP_NOSIZE = &H1
    Const GWL_EXSTYLE = (-20&)
    Const WS_EX_TOPMOST = &H8&

    Dim bMakeTop As Boolean
    Dim hwnd As LongPtr, lExStyle As LongPtr
  
    Call IUnknown_GetWindow(Form, VarPtr(hwnd))
  
    If GetActiveWindow = hwnd Then
        lExStyle = GetWindowLong(hwnd, GWL_EXSTYLE)
        If bOnTop And Not CBool(lExStyle And (WS_EX_TOPMOST)) Then
            bMakeTop = True
        ElseIf bOnTop = False And CBool(lExStyle And WS_EX_TOPMOST) Then
            bMakeTop = False
        Else
            Exit Sub
        End If
        Call SetWindowPos(hwnd, IIf(bMakeTop, HWND_TOPMOST, HWND_NOTOPMOST), 0&, 0&, 0&, 0&, SWP_NOMOVE Or SWP_NOSIZE)
    End If
End Sub


3- In the UserForm Module:
VBA Code: 
Option Explicit

Private oCtipsCollection As New Collection

Private Sub UserForm_Initialize()
    Call HookControls
    MakeTopWindow Me
End Sub

Private Sub HookControls()
    Dim oCtrl As Control
    Dim oTipInstance As CBringTiptoTop
  
    For Each oCtrl In Me.Controls
        If Len(oCtrl.ControlTipText) Then
            Set oTipInstance = New CBringTiptoTop
            oTipInstance.AddControl Me, oCtrl
            oCtipsCollection.Add oTipInstance
        End If
    Next oCtrl

End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
     MakeTopWindow Me
End Sub


PS: If the controls with scrrentips are located at the edges of the userform, the code may not work properly for restoring the HWND_TOPMOST zorder of the form... If this is an issue then the code will require additional steps.
 
Upvote 0
Solution
Jaafar Tribak said:
Try this and see how it goes :

Here is a workbook example :
DynamicFormZorder.xlsm

Basically, what the code does is dynamically change the form's ZOrder according to where the mouse cursor is currently located... If the cursor is over a control that has a screentip, the HWND_TOPMOST zorder of the form is temporarly removed hence the screentip is shown correctly.

The code relies on the controls and userform _MouseMove event.


1- Class Module: [CBringTiptoTop]
VBA Code: 
Option Explicit

Private WithEvents lbl As MsForms.Label
Private WithEvents txt As MsForms.TextBox
Private WithEvents cbx As MsForms.ComboBox
Private WithEvents lbx As MsForms.ListBox
Private WithEvents chx As MsForms.CheckBox
Private WithEvents opt As MsForms.OptionButton
Private WithEvents tgl As MsForms.ToggleButton
Private WithEvents frm As MsForms.Frame
Private WithEvents cbt As MsForms.CommandButton
Private WithEvents tbs As MsForms.TabStrip
Private WithEvents mlp As MsForms.MultiPage
Private WithEvents img As MsForms.Image

Private oForm As UserForm

Public Sub AddControl(ByVal Form As UserForm, ByVal Ctrl As MsForms.Control)

    Set oForm = Form
    Select Case True
        Case TypeOf Ctrl Is MsForms.Label
            Set lbl = Ctrl
        Case TypeOf Ctrl Is MsForms.TextBox
            Set txt = Ctrl
        Case TypeOf Ctrl Is MsForms.ComboBox
            Set cbx = Ctrl
        Case TypeOf Ctrl Is MsForms.ListBox
            Set lbx = Ctrl
        Case TypeOf Ctrl Is MsForms.CheckBox
            Set chx = Ctrl
        Case TypeOf Ctrl Is MsForms.OptionButton
            Set opt = Ctrl
        Case TypeOf Ctrl Is MsForms.ToggleButton
            Set tgl = Ctrl
        Case TypeOf Ctrl Is MsForms.Frame
            Set frm = Ctrl
        Case TypeOf Ctrl Is MsForms.CommandButton
            Set cbt = Ctrl
        Case TypeOf Ctrl Is MsForms.TabStrip
            Set tbs = Ctrl
        Case TypeOf Ctrl Is MsForms.MultiPage
            Set mlp = Ctrl
        Case TypeOf Ctrl Is MsForms.Image
            Set img = Ctrl
    End Select

End Sub

Private Sub GenericMouseMoveEvent(ByVal Ctrl As MsForms.Control)
     MakeTopWindow oForm, False
End Sub

Private Sub lbl_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(lbl)
End Sub
Private Sub txt_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(txt)
End Sub
Private Sub cbx_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(cbx)
End Sub
Private Sub lbx_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(lbx)
End Sub
Private Sub chx_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(chx)
End Sub
Private Sub opt_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(opt)
End Sub
Private Sub tgl_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(tgl)
End Sub
Private Sub frm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(frm)
End Sub
Private Sub cbt_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(cbt)
End Sub
Private Sub tbs_MouseMove(ByVal Index As Long, ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(tbs)
End Sub
Private Sub mlp_MouseMove(ByVal Index As Long, ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(mlp)
End Sub
Private Sub img_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call GenericMouseMoveEvent(img)
End Sub


2- In a Standard Module:
VBA Code: 
Option Explicit

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    #Else
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    #End If
    Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUF As LongPtr) As Long
    Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal uFlags As Long) As Long
    Private Declare PtrSafe Function GetTopWindow Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUF As LongPtr) As Long
    Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal uFlags As Long) As Long
    Private Declare Function GetTopWindow Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare Function GetActiveWindow Lib "user32" () As LongPtr
#End If


Public Sub MakeTopWindow(ByVal Form As UserForm, Optional bOnTop As Boolean = True)

    Const HWND_TOPMOST = -1&
    Const HWND_NOTOPMOST = -2&
    Const SWP_NOMOVE = &H2
    Const SWP_NOSIZE = &H1
    Const GWL_EXSTYLE = (-20&)
    Const WS_EX_TOPMOST = &H8&

    Dim bMakeTop As Boolean
    Dim hwnd As LongPtr, lExStyle As LongPtr
 
    Call IUnknown_GetWindow(Form, VarPtr(hwnd))
 
    If GetActiveWindow = hwnd Then
        lExStyle = GetWindowLong(hwnd, GWL_EXSTYLE)
        If bOnTop And Not CBool(lExStyle And (WS_EX_TOPMOST)) Then
            bMakeTop = True
        ElseIf bOnTop = False And CBool(lExStyle And WS_EX_TOPMOST) Then
            bMakeTop = False
        Else
            Exit Sub
        End If
        Call SetWindowPos(hwnd, IIf(bMakeTop, HWND_TOPMOST, HWND_NOTOPMOST), 0&, 0&, 0&, 0&, SWP_NOMOVE Or SWP_NOSIZE)
    End If
End Sub


3- In the UserForm Module:
VBA Code: 
Option Explicit

Private oCtipsCollection As New Collection

Private Sub UserForm_Initialize()
    Call HookControls
    MakeTopWindow Me
End Sub

Private Sub HookControls()
    Dim oCtrl As Control
    Dim oTipInstance As CBringTiptoTop
 
    For Each oCtrl In Me.Controls
        If Len(oCtrl.ControlTipText) Then
            Set oTipInstance = New CBringTiptoTop
            oTipInstance.AddControl Me, oCtrl
            oCtipsCollection.Add oTipInstance
        End If
    Next oCtrl

End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
     MakeTopWindow Me
End Sub


PS: If the controls with scrrentips are located at the edges of the userform, the code may not work properly for restoring the HWND_TOPMOST zorder of the form... If this is an issue then the code will require additional steps.
Click to expand...
Thank you very much. that is exactly what I was looking for.
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Solved
Catching the Mouse Click Error in Modal User Form
Replies
4
Views
304
huiettcm
H
W
  • Question
minimize and Maximize
Replies
4
Views
670
NdNoviceHlp
NdNoviceHlp
A
  • Question
What is wrong with this VBA code: userForm get hand ico for pointer on hover
2
Replies
15
Views
525
RoryA
RoryA
Jaafar Tribak
  • Question
Blurring images using Direct2D & Windows Imaging Component
Replies
3
Views
257
Dan_W
D
netspeedz
  • Solved
Load Image in User Form - 64bit Excel [VBA]
Replies
6
Views
382
netspeedz
netspeedz

Forum statistics

Threads
1,215,029
Messages
6,122,760
Members
449,095
Latest member
m_smith_solihull

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