Thomas Risi Softwareentwicklung

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 ' Hier die gewünschten Koordinaten vorgeben 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() ' Hier den Hook setzen ... Call SetHook ' ... und dann gleich die MsgBox aufrufen. 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

Bewerten Sie bitte dieses Programm.
1 2 3 4 5
Weniger nützlich Sehr nützlich
Bitte teilen Sie uns mit, warum Sie das Programm so bewertet haben. (optional)