Am 14 Oct 2005 07:53:49 -0700 schrieb (e-mail address removed):
Forcing a window to displaying on top is a lot of stuff in VBA because the
UserForm doesn´t provide you with its window handle.
I´m not familiar with UserForms. On the first look I can´t find an event
that fires after a modal dialog is being displayed. That is you´d need a
hack to call code after the Show 1 line.
Anyway, the same hack is necessary for a MsgBox and can be achieved by a
timer. Please google for "modTimer.bas", I have posted a sample several
times. Additionally copy the code below into "ThisOutlookSession".
Call the timer with a delay of maybe 100ms just before calling the MsgBox or
the UserForm.
In the ThisOutlookSession.Timer method, called back from the
modTimer.TimerProc method, you need then to:
1. Stop the Timer!
2. Call SetWindowPos* with the Caption of the Form/MsgBox:
Dim str$:str=UserForm1.Caption ' (or the MsgBox caption)
SetWindowTopMostActivateNoSize FindChildWindowText( _
GetDesktopWindowA, str)
<ThisOutlookSession>
Private Declare Function SetWindowPosA Lib "USER32" Alias "SetWindowPos"
(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) As Long
Private Declare Function GetDesktopWindowA Lib "USER32" Alias
"GetDesktopWindow" () As Long
Private Declare Function GetWindow Lib "USER32" (ByVal hwnd As Long, ByVal
wCmd As Long) As Long
Private Declare Function GetWindowTextA Lib "USER32" (ByVal hwnd As Long,
ByVal lpString As String, ByVal cch As Long) As Long
Const HWND_TOPMOST As Long = -1
Const SWP_SHOWWINDOW As Long = &H40
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Const GW_HWNDNEXT = 2
Const GW_CHILD = 5
Private Function SetWindowTopMostActivateNoSize(ByVal hwnd As Long) As Long
SetWindowTopMostActivateNoSize = _
SetWindowPosA(hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_SHOWWINDOW Or
SWP_NOMOVE Or SWP_NOSIZE)
End Function
Private Function FindChildWindowText(ByVal lHwnd As Long, _
sFind As String _
) As Long
Dim lRes As Long
Dim sFindLC As String
lRes = GetWindow(lHwnd, GW_CHILD)
If lRes Then
sFindLC = LCase$(sFind)
Do
If LCase$(GetWindowText(lRes)) = sFindLC Then
FindChildWindowText = lRes
Exit Function
End If
lRes = GetWindow(lRes, GW_HWNDNEXT)
Loop While lRes <> 0
End If
End Function
Private Function GetWindowText(ByVal lHwnd As Long) As String
Const STR_SIZE As Long = 256
Dim sBuffer As String * STR_SIZE
Dim lSize As Long
sBuffer = String$(STR_SIZE, vbNullChar)
lSize = GetWindowTextA(lHwnd, sBuffer, STR_SIZE)
If lSize > 0 Then
GetWindowText = left$(sBuffer, lSize)
End If
End Function
</ThisOutlookSession>
