Keeping Userforms on top of SDI windows in Excel 2013 and up
Pages in this article
-
MDI vs SDI
-
The code
I have provided a
demo file
with the code shown below.
Code explanation
After having used the solution that involved making the userform the
stay always on top of all Windows I decided this isn't the best solution
after all. The problem with this solution rears its ugly head when you
show a messagebox from the userforms code: the messagebox will appear
behind the form!
The new solution listed here changes the parent window of the
userform using a few API calls.
To make this portable, I created a class module with the code that
does the heavy lifting.
In a class called cFormOnTop, add this code:
Option Explicit
'Object variable to trigger application events
Private WithEvents
XLApp As Excel.Application
#If VBA7 Then
Dim mXLHwnd
As LongPtr 'Excel's window handle
Dim mhwndForm
As LongPtr 'The
userform's window handle
Private Declare
PtrSafe Function FindWindowA
Lib "user32" (ByVal
lpClassName As String,
ByVal lpWindowName As
String) As
LongPtr
#If Win64 Then
Private
Declare PtrSafe
Function
SetWindowLongA Lib "user32" Alias
"SetWindowLongPtrA" (ByVal hwnd
As LongPtr,
ByVal nIndex As
Long, ByVal
dwNewLong
As LongPtr) As
LongPtr
#Else
Private
Declare PtrSafe
Function
SetWindowLongA Lib
"user32" (ByVal hwnd As
LongPtr, ByVal nIndex
As
Long, ByVal dwNewLong
As LongPtr)
As LongPtr
#End If
Private Declare
PtrSafe Function SetForegroundWindow
Lib "user32" (ByVal
hwnd As LongPtr) As
Long
#Else
Dim mXLHwnd
As Long 'Excel's
window handle
Dim mhwndForm
As Long 'The userform's
window handle
Private Declare
Function FindWindowA
Lib
"user32" (ByVal lpClassName
As String,
ByVal lpWindowName As
String) As
Long
Private Declare
Function SetWindowLongA
Lib "user32" (ByVal
hwnd As Long,
ByVal nIndex As
Long, ByVal dwNewLong
As
Long) As Long
Private Declare
Function SetForegroundWindow
Lib "user32" (ByVal
hwnd As Long) As
Long
#End If
Const GWL_HWNDPARENT As
Long = -8
Private moTheUserform
As
Object
Public Sub
InitializeMe()
If Val(Application.Version) >= 15
Then 'Only makes sense on Excel 2013
and up
Set XLApp = Application
End If
End Sub
Private Sub
Class_Terminate()
Set XLApp =
Nothing
Set moTheUserform =
Nothing
End Sub
Private Sub
XLApp_WindowActivate(ByVal
Wb As Workbook, ByVal
Wn As Window)
If Val(Application.Version) >= 15 And
mhwndForm <> 0 Then 'Basear
o form na janela ativa do Excel.
mXLHwnd = Application.hwnd 'Always get
because in Excel 15 SDI each wb has its window with different
handle.
SetWindowLongA mhwndForm, GWL_HWNDPARENT, mXLHwnd
SetForegroundWindow mhwndForm
End If
End Sub
Private Sub
XLApp_WindowResize(ByVal
Wb As Workbook, ByVal
Wn As Window)
If Not
moTheUserform.Visible Then
moTheUserform.Show vbModeless
End Sub
Private Sub
XLApp_WorkbookBeforeClose(ByVal
Wb As Workbook, Cancel
As Boolean)
SetWindowLongA mhwndForm, GWL_HWNDPARENT, 0&
End Sub
Public Property
Set TheUserform(ByVal
oNewValue As Object)
Set moTheUserform = oNewValue
mhwndForm = FindWindowA("ThunderDFrame", moTheUserform.Caption)
End Property
After adding this class to your project, this is all code you need to
add to your userform (works in Excel 2000-2021, 365, 32 and 64 bit):
Private mclsFormOnTop
As
cFormOnTop
Private Sub
UserForm_Initialize()
Set mclsFormOnTop =
New cFormOnTop
Set mclsFormOnTop.TheUserform = Me
mclsFormOnTop.InitializeMe
End Sub
Conclusion
With the change from MDI to SDI, Excel 2013 has broken some solutions
that depend on userforms staying on top of the Excel window regardless
which workbook is the active workbook. The code demonstrated in this
article shows you one way to overcome this limitation.
The previous (incorrect) solution is shown below for completeness'
sake.
One way around this problem is by setting the userform to be always
on top using some Windows API calls.
The problem can be solved rather simple, by using some code that
calls a couple of Windows API functions. All code could go inside the
userform's code window. Unfortunately, because I chose to make the form
topmost, we must handle the fact that another application might become
the foreground window. For example: you are running Excel with the
userform showing and then you open Word. In the simple case, the
userform will stay on top of Word, which is not what we want.
So I opted for a solution which is more complex because it
- handles multiple userforms,
- hides all userforms when another application becomes the active
application.
The sample file has these VBA objects:
The VBA Editor showing the sample file's VBA Project tree.
Object name
Description of the object
ufWorkbooks
A userform to test the code
modShowForm
Code to show the form
modTopMost
Code that handles hiding and showing of the form when
Excel looses focus
clsForms
A class used by modTopMost to hold the form properties
needed by that module
clsTopMost
Code to make the form topmost.
Since we're using a class module that does the heavy lifting, the
code that is needed in the form is straightforward:
- Variable declaration for the class's instance (in the
declaration section of the form, at the top of its module):
Dim mcTopMost
As clsTopMost
- Instantiate a class instance, pass the form to it and make the
form topmost (put this in a routine that is called during
initialisation of the form):
If Val(Application.Version) >= 15
Then
'Only makes sense on Excel 2013 and up
Set mcTopMost =
New clsTopMost
Set mcTopMost.Form = Me
mcTopMost.MakeTopMost
AddForm Me
End If
- To enable hiding of the form when Excel is no longer the
foremost window, we pass the form to a routine in modTopMost:
AddForm Me
The clsTopMost class
The code in clsTopMost is not very complex, its most important part
is a number of API function declarations and the proper way to call them
to change the userform so it is "always on top".
Option Explicit
#If VBA7 Then
Dim mhwndForm As
LongPtr
'The userform's window handle
Private Declare
PtrSafe Function FindWindow32
Lib "USER32" Alias "FindWindowA" (ByVal
lpClassName As
String, _
ByVal lpWindowName As
String) As
LongPtr
Private Declare
PtrSafe Sub 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
wFlags
As Long)
Private Const
HWND_TOPMOST As LongPtr = -1
Private Const
HWND_NOTOPMOST As LongPtr = -2
#Else
Dim mhwndForm As
Long
'The userform's window handle
Private Declare
Function FindWindow32
Lib "USER32" Alias "FindWindowA" (ByVal
lpClassName
As String, _
ByVal lpWindowName As
String) As
Long
Private Declare
Sub 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
wFlags
As Long)
Private Const
HWND_TOPMOST As Long
= -1
Private Const
HWND_NOTOPMOST As Long
= -2
#End If
Private Const
SWP_NOSIZE
As Long = &H1
Private Const
SWP_NOMOVE
As Long = &H2
Private Const
SWP_NOACTIVATE
As Long = &H10
Private Const
SWP_SHOWWINDOW
As Long = &H40
Private moForm As
Object
Public Sub
MakeTopMost()
#If VBA7 Then
Dim lngParm As
LongPtr
#Else
Dim lngParm As
Long
#End If
mhwndForm = FindWindow32("ThunderDFrame", moForm.Caption)
lngParm = IIf(mhwndForm, HWND_TOPMOST, HWND_NOTOPMOST)
SetWindowPos mhwndForm, lngParm, 0, 0, 0, 0, (SWP_NOACTIVATE
Or SWP_SHOWWINDOW Or
SWP_NOMOVE Or SWP_NOSIZE)
End Sub
Private Sub
Class_Terminate()
Set moForm =
Nothing
End Sub
Public Property
Get Form() As
Object
Set Form = moForm
End Property
Public Property
Set Form(oForm As
Object)
Set moForm = oForm
End Property
Public Property
Get hwnd() As
Long
hwnd = mhwndForm
End Property
Note that I used conditional compilation in this code, so you can
plug it into a workbook that might be used in older Excel versions
without compile errors.
The module modTopMost
Now this is where things become a bit more complex; I need a way to
find out whether or not Excel is the foreground window, or perhaps any
of the userforms currently shown from Excel. All of the code in
modTopMost follows below...
Option Explicit
'Handles Keeping modeless forms on top of Excel
#If VBA7 Then
Dim mXLHwnd As
LongPtr 'Excel's window handle
Declare PtrSafe
Function FindWindow32 Lib "USER32"
Alias "FindWindowA" (ByVal lpClassName
As String, _
ByVal lpWindowName As
String) As
LongPtr
Declare PtrSafe
Function GetForegroundWindow Lib
"user32.dll" () As LongPtr
#Else
Dim mXLHwnd As
Long 'Excel's window
handle
Declare Function
FindWindow32 Lib "USER32" Alias
"FindWindowA" (ByVal lpClassName
As
String, _
ByVal lpWindowName As
String) As
Long
Declare Function
GetForegroundWindow Lib "user32.dll" ()
As Long
#End If
Dim mcForms As
Collection
Dim mdNextTime As
Double
Public Sub
AddForm(oForm
As Object)
Dim cForm As
clsForms
If mcForms Is
Nothing Then
Set mcForms =
New Collection
End If
Set cForm = New
clsForms
cForm.hwnd = FindWindow32("ThunderDFrame", oForm.Caption)
Set cForm.Form = oForm
mcForms.Add cForm
Application.OnTime Now, "HandleFormHideUnHide"
End Sub
Public Sub
RemoveForm(oForm2Remove
As Object)
Dim cForm As
clsForms
Dim lIndex As
Long
If Not
mcForms
Is Nothing
Then
On
Error Resume
Next
For lIndex = mcForms.Count
To 1 Step -1
If mcForms(lIndex).Caption
= oForm2Remove.Form.Caption Then
'If this errors, we arrive here and should remove
that form because its object was lost
'if it doesn't error, we remove the form because
the captions are the same
mcForms.Remove lIndex
End If
Next
End If
End Sub
Public Sub
HandleFormHideUnHide()
Dim oForm
As Object
Dim lIndex As
Long
Dim lHwndForeGround
As LongPtr
Dim bShow As
Boolean
If mcForms
Is Nothing
Then Exit
Sub
mXLHwnd = FindWindow32("XLMAIN", Application.Caption)
If mXLHwnd = GetForegroundWindow
Then
bShow = True
Else
bShow = False
For lIndex = 1 To
mcForms.Count
If GetForegroundWindow =
mcForms(lIndex).hwnd
Then
bShow = True
Exit For
End If
Next
End If
HideOrShow bShow
mdNextTime = Now + TimeValue("00:00:01")
Application.OnTime mdNextTime, "HandleFormHideUnHide"
End Sub
Sub Unschedule()
On Error
Resume Next
Application.OnTime mdNextTime, "HandleFormHideUnHide", ,
False
Set mcForms =
Nothing
End Sub
Private Sub
HideOrShow(bShow
As Boolean)
Dim lIndex As
Long
On Error
Resume Next
For lIndex = mcForms.Count To 1
Step -1
Err.Clear
If bShow
Then
mcForms(lIndex).Form.Show vbModeless
Else
mcForms(lIndex).Form.Hide
End
If
If Err.Number <> 0
Then
mcForms.Remove lIndex
End
If
Next
End Sub
The routines in this module are described below:
AddForm
Adds a userform to the list of forms to "watch".
RemoveForm
Removes a form from the list.
HandleFormHideUnHide
A routine that is called every second which checks whether Excel or
one of its userforms is on top and acts accordingly.
Unschedule
Cancels the timed routine when the last userform is removed from
memory or when the workbook is closed.
HideOrShow
Hides or displays all userforms.
This class is used to be able to get the window handles of the
userforms easily, used from modTopMost.
The code in the class is:
Option Explicit
Private msCaption As
String
Private moForm As
Object
#If VBA7 Then
Dim mlHwnd As
LongPtr
#Else
Dim mlHwnd As
Long
#End If
Private Sub
Class_Terminate()
Set moForm =
Nothing
End Sub
Public Property
Get Caption() As
String
Caption = msCaption
End Property
Public Property
Let Caption(sCaption As
String)
msCaption = sCaption
End Property
#If VBA7 Then
Public Property
Get hwnd() As
LongPtr
#Else
Public Property
Get hwnd() As
Long
#End If
hwnd = mlHwnd
End Property
#If VBA7 Then
Public Property
Let hwnd(lHwnd As
LongPtr)
#Else
Public Property
Let hwnd(lHwnd As
Long)
#End If
mlHwnd = lHwnd
End Property
Public Property
Get Form() As
Object
Set Form = moForm
End Property
Public Property
Set Form(oForm As
Object)
Set moForm = oForm
End Property