Some changes (thanks to Peter T) and now it works all fine:
In the userform:
------------------
Option Explicit
Private Sub UserForm_Terminate()
TimerOff
End Sub
In the normal module:
-------------------------
Option Explicit
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function GetWindowThreadProcessId _
Lib "user32" (ByVal hwnd As Long, _
ByRef lpdwProcessId As Long) As Long
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
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetWindowLongA Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Const GWL_HWNDPARENT As Long = -8
Private bTimerEnabled As Boolean
Private dTimerInterval As Double
Private lExcelHwnd As Long
Private lFormHwnd As Long
Private lExcelWindowState As Long
Private lExcelWindowStatePrevious As Long
Sub LoadForm()
Load frmBart
UserForm1.Show 0
'set all the relevant private variables
lExcelHwnd = GetExcelHwnd()
lFormHwnd = GetFormHwnd(UserForm1.Caption)
lExcelWindowStatePrevious = 0
bTimerEnabled = True
dTimerInterval = TimeSerial(0, 0, 1)
'start the timer
RunTimer
End Sub
Sub TimerOff()
bTimerEnabled = False
End Sub
Sub SetFormParent()
lExcelWindowState = IsIconic(lExcelHwnd)
If lExcelWindowState <> lExcelWindowStatePrevious Then
If lExcelWindowState = 0 Then
SetWindowLongA lFormHwnd, GWL_HWNDPARENT, lExcelHwnd
Else
SetWindowLongA lFormHwnd, GWL_HWNDPARENT, 0&
End If
lExcelWindowStatePrevious = lExcelWindowState
'seems needed this
'-----------------
UserForm1.Hide
UserForm1.Show vbModeless
End If
End Sub
Sub RunTimer()
SetFormParent
If bTimerEnabled Then
Application.OnTime (Now + dTimerInterval), "RunTimer"
End If
End Sub
Function GetExcelHwnd() As Long
'------------------------------------------------------------
'Finds a top-level window of the given class and
'caption that belongs to this instance of Excel,
'by matching the process IDs
'Arguments: sClass The window class name to look for
' sCaption The window caption to look for
'Returns: Long The handle of Excel's main window
'------------------------------------------------------------
Dim hWndDesktop As Long
Dim hwnd As Long
Dim hProcThis As Long
Dim hProcWindow As Long
Dim sClass As String
Dim sCaption As String
If Val(Application.Version) >= 10 Then
GetExcelHwnd = Application.hwnd
Exit Function
End If
sClass = "XLMAIN"
sCaption = Application.Caption
'All top-level windows are children of the desktop,
'so get that handle first
hWndDesktop = GetDesktopWindow
'Get the ID of this instance of Excel, to match
hProcThis = GetCurrentProcessId
Do
'Find the next child window of the desktop that
'matches the given window class and/or caption.
'The first time in, hWnd will be zero, so we'll get
'the first matching window. Each call will pass the
'handle of the window we found the last time, thereby
'getting the next one (if any)
hwnd = FindWindowEx(hWndDesktop, hwnd, sClass, sCaption)
'Get the ID of the process that owns the window we found
GetWindowThreadProcessId hwnd, hProcWindow
'Loop until the window's process matches this process,
'or we didn't find the window
Loop Until hProcWindow = hProcThis Or hwnd = 0
'Return the handle we found
GetExcelHwnd = hwnd
End Function
Function GetFormHwnd(strCaption As String) As Long
If Val(Application.Version) >= 9 Then
GetFormHwnd = FindWindow("ThunderDFrame", strCaption)
Else
GetFormHwnd = FindWindow("ThunderXFrame", strCaption)
End If
End Function
Start by running LoadForm()
RBS
OK, spoke to soon and seen situations where this doesn't work well at
all.
Will post something better later.
RBS
