Keep Word UserForm on top of other documents

[gmaxey]

I have a standard code module and userform in a word document.




When the userform is displayed, I have managed to keep that form displayed regardless if I switch to another open document, open a different document or launch or switch to another application.


My goals is to keep the userform displayed ONLY if I switch to another open document or open another document. If I switch to another application or launch another application, I do not want the userform to display.


Thanks for any help. The document is also attached.



Standard module code:

Option Explicit
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const HWND_TOP = 0
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2

#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
  Public Declare PtrSafe Function BringWindowToTop 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
Dim oFrm As frmDemo
Sub ShowFormOnTopofApp()
  Set oFrm = New frmDemo
  oFrm.Show vbModeless
lbl_Exit:
  Exit Sub
End Sub

Userform code:

Option Explicit
Private Sub UserForm_Initialize()
  AlwaysOnTop Me.caption
End Sub
Private Sub AlwaysOnTop(caption As String)
#If VBA7 Then
  Dim hWnd As LongPtr
#Else
  Dim hWnd As LongPtr
#End If
Dim lngResult As Long
  hWnd = FindWindow("ThunderDFrame", caption)
  If hWnd <> 0 Then
    'This keeps the form displayed if another document or different application is launched.
    lngResult = SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
    'Trying to adapt to stet out the above line and keep form displayed only if another document in Word is opened (or switched to another already open document).
    'It seems like the following should work but is doesn't.
    lngResult = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
    End If
lbl_Exit:
  Exit Sub
End Sub

[gmaxey]

I managed to cobble something together using application events.

Option Explicit
Private WithEvents oApp As Word.Application
#If VBA7 Then
  Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
  Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hwnd As LongPtr) As LongPtr
  Private Declare PtrSafe Function SetWindowLongA Lib "user32" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
  Private Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
  Dim m_AppHwnd As LongPtr
  Dim m_UFHwnd As LongPtr
#Else
  Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hwnd As LongPtr) 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
  Dim m_AppHwnd As Long
  Dim m_UFHwnd As Long
#End If
Const GWL_HWNDPARENT As Long = -8
Private Sub UserForm_Initialize()
Dim oDoc As Document
  If val(Application.Version) >= 15 Then
    m_AppHwnd = Application.ActiveWindow.hwnd
  Else
    m_AppHwnd = FindWindow("OpusApp", vbNullString)
  End If
  Set oApp = Application
lbl_Exit:
  Exit Sub
End Sub
Private Sub UserForm_Activate()
 IUnknown_GetWindow Me, VarPtr(m_UFHwnd)
  If m_UFHwnd = 0 Then m_UFHwnd = FindWindow("ThunderDFrame", Caption)
End Sub
Private Sub oApp_WindowActivate(ByVal Wb As Document, ByVal Wn As Window)
  If m_UFHwnd <> 0 Then
    If val(Application.Version) >= 15 Then
      m_AppHwnd = Application.ActiveWindow.hwnd
    Else
      m_AppHwnd = FindWindow("OpusApp", vbNullString)
    End If
    SetWindowLongA m_UFHwnd, GWL_HWNDPARENT, m_AppHwnd
    SetForegroundWindow m_UFHwnd
  End If
lbl_Exit:
  Exit Sub
End Sub
Private Sub oApp_WindowResize(ByVal Wb As Document, ByVal Wn As Window)
  If Not Visible Then Show vbModeless
lbl_Exit:
  Exit Sub
End Sub
Private Sub oApp_DocumentBeforeClose(ByVal Wb As Document, Cancel As Boolean)
  SetWindowLongA m_UFHwnd, GWL_HWNDPARENT, 0&
lbl_Exit:
  Exit Sub
End Sub