Thomas Risi Softwareentwicklung
Addins - Datenbanklösungen - Komponenten - RTDServer - WebServices
MsgBox immer an gleicher Position öffnen
Aus einer Frage in einem Forum ...
Ist es mit VBA irgendwie möglich, daß sich eine MsgBox immer an der gleichen Position öffnet?
Ja, ist möglich. Und das funktioniert nicht nur mit MsgBox's ...
Quellcode für z.B. Modul1 ...
Option Explicit
Public Declare Function UnhookWindowsHookEx Lib "user32" ( _
ByVal hHook As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" ( _
ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
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 wFlags As Long) As Long
Public Declare Function GetWindowRect Lib "user32" ( _
ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Public Const GWL_HINSTANCE = (-6)
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOZORDER = &H4
Public Const SWP_NOACTIVATE = &H10
Public Const HCBT_ACTIVATE = 5
Public Const WH_CBT = 5
Public Const POS_X = 200&
Public Const POS_Y = 100&
Public hHook As Long
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Function WinProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If lMsg = HCBT_ACTIVATE Then
SetWindowPos wParam, 0, POS_X, POS_Y, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE
UnhookWindowsHookEx hHook
End If
WinProc = False
End Function
Quellcode für z.B. UserForm1 ...
Option Explicit
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Sub CommandButton1_Click()
Call SetHook
MsgBox "TEST ..."
End Sub
Private Function GetHandleUF(uf As MSForms.UserForm) As Long
GetHandleUF = IIf(Int(Val(Application.Version)) < 9, _
FindWindow("ThunderXFrame", uf.Caption), FindWindow("ThunderDFrame", uf.Caption))
End Function
Private Sub SetHook()
Dim hInst As Long
Dim hThread As Long
hInst = GetWindowLong(GetHandleUF(Me), GWL_HINSTANCE)
hThread = GetCurrentThreadId()
hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProc, hInst, hThread)
End Sub
© 2001 -
by Thomas Risi