Userform.... Always on top

[mtheriault2000]

Hello

I need a userform to be always on top of any Windows applications. Is it possible.

I want to use it to reduce the amount of paper i print. At the moment, i make a printout of data that i need to enter in an applcation. Having my data on the screen will help me reducing my waste of paper and be more ecological.

Nice idea that i got, but i have no idea how to start it.

Any one could help me? Any hint hint greatly appreciated

Martin
P.S. As usual, please excuse my English

 

[John_w]

Yes, this is possible.

Put this code in a new standard Module:

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 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

And put this code in your Userform module:

Option Explicit

Private Sub UserForm_Initialize()

    Const C_VBA6_USERFORM_CLASSNAME = "ThunderDFrame"
    
    Dim ret As Long
    Dim formHWnd As Long
    
    'Get window handle of the userform
    
    formHWnd = FindWindow(C_VBA6_USERFORM_CLASSNAME, Me.Caption)
    If formHWnd = 0 Then
        Debug.Print Err.LastDllError
    End If

    'Set userform window to 'always on top'
    
    ret = SetWindowPos(formHWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
    If ret = 0 Then
        Debug.Print Err.LastDllError
    End If
    
End Sub

 

[mtheriault2000]

Hello John

Very good start, i was able to load and unload a permanent window.

Greatly appreciated

Martin

 

[Nayasoch]

Jhon is there any way I could add minimize button on to it and most importantly have it on top of every other window but able to open other excel workbooks from my local Desktop.

Help will be very much appreciated.

 

[John_w]

Try this new code. I've improved the finding of the userform window and the Win API declarations have been updated for VBA7.

Standard module:

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_MAXIMIZEBOX = &H10000
Public Const WS_MINIMIZEBOX = &H20000
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

Userform module:

Option Explicit


Private Sub UserForm_Initialize()
    AlwaysOnTop Me.caption
    AddButtons Me.caption, WS_MINIMIZEBOX 'minimise box only
    'AddButtons Me.caption, WS_MINIMIZEBOX Or WS_MAXIMIZEBOX     'minimise and maximise boxes
End Sub


Private Sub AlwaysOnTop(caption As String)

    Dim hWnd As Long, lResult As Long
    
    If Val(Application.Version) >= 9 Then
        hWnd = FindWindow("ThunderDFrame", caption)
    Else
        hWnd = FindWindow("ThunderXFrame", caption)
    End If
    
    If hWnd <> 0 Then
    
        lResult = SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
        
    Else
    
        MsgBox "AlwaysOnTop: userform with caption '" & caption & "' not found"
        
    End If
    
End Sub


Private Sub AddButtons(caption As String, buttonStyle As Long)

    Dim hWnd As Long, lstyle As Long, lResult As Long
    
    If Val(Application.Version) >= 9 Then
        hWnd = FindWindow("ThunderDFrame", caption)
    Else
        hWnd = FindWindow("ThunderXFrame", caption)
    End If
    
    If hWnd <> 0 Then
    
        lstyle = GetWindowLong(hWnd, GWL_STYLE)
        lstyle = lstyle Or WS_SYSMENU Or buttonStyle
        
        'Add specified icons to userform
        
        lResult = SetWindowLong(hWnd, GWL_STYLE, lstyle)
        If lResult = 0 Then
            Debug.Print "SetWindowLong error:"; Err.LastDllError
        End If

        DrawMenuBar hWnd

    Else
    
        MsgBox "AddButtons: userform with caption '" & caption & "' not found"
    
    End If
    
End Sub

If you show the userform modally (the default):

UserForm1.Show vbModal

and show the Windows desktop then the userform remains on top.

 

[gklewis83]

It turns out that Excel 2013 cannot open an Excel 2007 workbook with the above code.

Compile error:

The code in this project must be updated for use on 64-bit systems. Please review and update Declare statements and then mark them with the PtrSafe attribute.

Please update this thread with the full code as indicated by the compile error.

 

[My Aswer Is This]

I think you should start a new posting with your question.

It turns out that Excel 2013 cannot open an Excel 2007 workbook with the above code.

Please update this thread with the full code as indicated by the compile error.

 

[gklewis83]

I think you should start a new posting with your question.

Seriously asking: Wouldn't that defeat the purpose of updating this post which is already called "Userform... Always on Top"? What would I call the new thread, as I would want to title the new one as the same (or at least very similar)?

Thanks for any help!

 

[Greg Truby]

I think you should start a new posting with your question.

As a moderator, my opinion would be that there is no need to start a new thread. Indeed, users that migrate from lower versions of Excel may have consulted or bookmarked this thread and come back to it seeking solutions should their code stop working.

It turns out that Excel 2013 cannot open an Excel 2007 workbook with the above code.

Please update this thread with the full code as indicated by the compile error.

I'm afraid I haven't the time to run through each of the above WinAPI declarations, but as a general rule, use the Win64 compiling constant. This is NOT based on the code seen in any previous post on this thread, I am simply copying and pasting code from a module in an add-in I'm working on at the moment for you to view as an example:

Option Explicit
Option Private Module


'··············································································
'      • • •   M O D U L E - L E V E L   D E C L A R A T I O N S   • • •
'··············································································




#If Win64 Then
'// __64-bit declarations___________________________________________________________


'// used by: fnExcelInstances
Declare PtrSafe Function GetDesktopWindow _
                Lib "user32" () _
                As LongPtr
                
'// used by: fnExcelInstances
Declare PtrSafe Function FindWindowEx _
                Lib "user32" _
                Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, _
                                       ByVal hWnd2 As LongPtr, _
                                       ByVal lpsz1 As String, _
                                       ByVal lpsz2 As String) _
                As LongPtr
                
'// used by: fnExcelCount
Declare PtrSafe Function FindWindow _
                Lib "user32" _
                Alias "FindWindowA" (ByVal lpClassName As String, _
                                     ByVal lpWindowName As String) _
                As LongPtr
                
'// used by: fnGetKeyState
Declare PtrSafe Function GetKeyState _
                Lib "user32" (ByVal nVirtKey As Long) _
                As Integer


'// used by: fnExcelCount
Declare PtrSafe Function GetWindow _
                Lib "user32" (ByVal hwnd As LongPtr, _
                              ByVal wCmd As Long) _
                As LongPtr


'// used by: fnExcelCount
Declare PtrSafe Function GetClassName _
                Lib "user32" _
                Alias "GetClassNameA" (ByVal hwnd As LongPtr, _
                                       ByVal lpClassName As String, _
                                       ByVal nMaxCount As Long) _
                As Long
                                                                               
Declare PtrSafe Function GetWindowText _
                Lib "user32" _
                Alias "GetWindowTextA" (ByVal hwnd As LongPtr, _
                                        ByVal lpString As String, _
                                        ByVal cch As Long) _
                As Long


Private Declare PtrSafe Function PathIsNetworkPath _
                        Lib "shlwapi.dll" _
                        Alias "PathIsNetworkPathA" (ByVal strPath As String) _
                        As Long


                                                                               #Else
'// __32-bit declarations___________________________________________________________


'// used by: fnExcelInstances
Private Declare Function GetDesktopWindow Lib "user32" () As Long


'// used by: fnExcelInstances
Private Declare Function FindWindowEx _
                Lib "user32" _
                Alias "FindWindowExA" (ByVal hWnd1 As Long, _
                                       ByVal hWnd2 As Long, _
                                       ByVal lpsz1 As String, _
                                       ByVal lpsz2 As String) _
                As Long
                                                                             
'// used by: fnExcelCount
Private Declare Function FindWindow _
                Lib "user32" _
                Alias "FindWindowA" (ByVal lpClassName As String, _
                                     ByVal lpWindowName As String) _
                As Long
                                                                             
'// used by: fnGetKeyState
Private Declare Function GetKeyState _
                Lib "user32" (ByVal nVirtKey As Long) _
                As Integer
               
'// used by: fnExcelCount
Private Declare Function GetWindow _
                Lib "user32" (ByVal hwnd As Long, _
                              ByVal wCmd As Long) _
                As Long


'// used by: fnExcelCount
Private Declare Function GetClassName _
                Lib "user32" _
                Alias "GetClassNameA" (ByVal hwnd As Long, _
                                       ByVal lpClassName As String, _
                                       ByVal nMaxCount As Long) _
                As Long
                                                                             
Private Declare Function GetWindowText _
                Lib "user32" _
                Alias "GetWindowTextA" (ByVal hwnd As Long, _
                                        ByVal lpString As String, _
                                        ByVal cch As Long) _
                As Long
                
Private Declare Function PathIsNetworkPath _
                Lib "shlwapi.dll" _
                Alias "PathIsNetworkPathA" (ByVal strPath As String) _
                As Long
                
                                                                             
                                                                             #End If
'// __32 & 64-bit___________________________________________________________________

 

[gklewis83]

@Greg Truby: Thank you for taking the time to answer!