Keeping Userforms on top of SDI windows in Excel 2013 and up

Pages in this article

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.

Previous solution: keep userform on top

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.

Code needed in the form

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.

The class clsForms

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

Comments

Loading comments...