John Peter
New Member
- Joined
- Apr 30, 2022
- Messages
- 10
- Office Version
- 365
- Platform
- 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