View Single Post
 
Old 12-29-2024, 03:47 PM
gmaxey gmaxey is offline Windows 10 Office 2019
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,617
gmaxey is just really nicegmaxey is just really nicegmaxey is just really nicegmaxey is just really nicegmaxey is just really nice
Default

I managed to cobble something together using application events.

Code:
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
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote