miniversum
Oct 22, 2012, updated at 10:16:42 (UTC)
view4105
view4
0
Goto Top

Move Event des Application Fenster gesucht

GermansolvedQuestionVB for ApplicationsDevelopment

Ich suche etwas Vergleichbares zu UserForm_Layout() oder andere Möglichkeit eine Bewegung des Application Fensters zu erkennen.

Hallo

ich habe ein Add-In in Excel programmiert.
Dieses Add-In enthält unter anderem ein Fenster (UserForm) zur Steuerung.
Nun ist das Problem das beim Verschieben des Fensters der Excel Anwendung die UserForm sich nicht mit verschiebt.
Ich hätte das Ganze gerne so das sich die UserForm relativ zum Excel Fenster mit verschiebt.
Das Positionieren der Userform mit .Top und .Left wäre auch nicht das Problem.
Nur müsste ich, um ein relatives Verschieben zu realisieren, die Position des Excel Fensters haben (um damit die Position der UserForm zu errechnen) und einen Event der ausgelöst wird sobald das Excel Fenster verschoben wird.
Für eine Form kenne ich diesen Event mit:
Private Sub UserForm_Layout()
    Debug.Print Me.Top, Me.Left, Me.Height, Me.Width
End Sub

Für das Hauptfenster habe ich aber keine Idee wie das gehen könnte.
Ich suche also nach einer Funktion in der Art Application_Layout().
Gesucht habe ich zwar schon aber ich habe nicht mal ansatzweiße eine Idee erhalten (oder unter den flaschen Suchbegriffen gesucht)

Das ganze soll unter Windowx xp mit Excel 2003 genau so laufen wir unter Windows 7 mit Excel 2010.

Ich bin für alle Ansatzpunkte dankbar.

Gruß
miniversum
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 193108

Url: https://administrator.de/contentid/193108

Printed on: April 25, 2024 at 12:04 o'clock

4 Comments
Latest comment
Goto Top
Member: rubberman
rubberman Oct 27, 2012 at 17:02:31 (UTC)
Goto Top
Hallo miniversum.

Wie du sicher schon herausgefunden hast, gibt es so ein Event nicht für Excel.
Du musst schon die WinAPI bemühen. Leider habe ich aber erst heute die Zeit gefunden, um mich damit zu beschäftigen (hoffe, noch nicht zu spät).

Natürlich wollte ich das Rad nicht neu erfinden und habe im Netz nach ähnlichen Umsetzungen gesucht. Du kannst dir hier das Beispiel genauer ansehen, dass ich für dein Vorhaben adaptiert habe. Dort findest du auch einiges an Erklärungen und Kommentaren.

Zum Test eine Neue Exceldatei erstellen, mit 2 Standardmodulen (Modul1, Modul2). Weiterhin ein Formular (UserForm1) mit einem Textfeld (TextBox1).

In "Modul1":
Option Explicit

Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _  
    ByVal hwnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long
 
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ( _  
    ByVal lpPrevWndFunc As Long, _
    ByVal hwnd As Long, _
    ByVal MSG As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long

Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _  
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long

Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long  

Private Declare Function ShowWindow Lib "user32.dll" ( _  
    ByVal hwnd As Long, _
    ByVal nCmdShow As Long) As Long

Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _  
    ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByRef lParam As Any) As Long

Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" ( _  
    ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long

Private Declare Function SetTimer Lib "user32.dll" ( _  
    ByVal hwnd As Long, _
    ByVal nIDEvent As Long, _
    ByVal uElapse As Long, _
    ByVal lpTimerFunc As Long) As Long

Private Declare Function KillTimer Lib "user32.dll" ( _  
    ByVal hwnd As Long, _
    ByVal nIDEvent As Long) As Long

Private Declare Function LockWindowUpdate Lib "user32.dll" ( _  
    ByVal hwndLock As Long) As Long

Private Declare Function GetProp Lib "user32" Alias "GetPropA" ( _  
    ByVal hwnd As Long, _
    ByVal lpString As String) As Long

Private Declare Function SetProp Lib "user32" Alias "SetPropA" ( _  
    ByVal hwnd As Long, _
    ByVal lpString As String, _
    ByVal hData As Long) As Long

Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" ( _  
    ByVal hwnd As Long, _
    ByVal lpString As String) As Long

Private Const GWL_WNDPROC   As Long = -4
Private Const WM_USER As Long = &H400
Private Const WM_MOVE As Long = &H3
Private Const WM_EXITSIZEMOVE As Long = &H232
Private Const WM_SETREDRAW As Long = &HB

Private Const VBE_CLASS_NAME As String = "wndclass_desked_gsk"  
Private Const EXCEL_CLASS_NAME As String = "XLMAIN"  

Private lOldWinProc As Long
Private lVBEhwnd As Long

Sub Safe_Subclass(hwnd As Long)
 
    If GetProp(GetDesktopWindow, "HWND") <> 0 Then  
        Exit Sub
    End If
    SetProp GetDesktopWindow, "HWND", hwnd  
    lVBEhwnd = FindWindow(VBE_CLASS_NAME, vbNullString)
    LockWindowUpdate lVBEhwnd
    SendMessage GetDesktopWindow, ByVal WM_SETREDRAW, ByVal 0&, 0&
    PostMessage lVBEhwnd, ByVal WM_USER + &HC44, ByVal &H30, ByVal 0&
    PostMessage lVBEhwnd, ByVal WM_USER + &HC44, ByVal &H33, ByVal 0&
    PostMessage lVBEhwnd, ByVal WM_USER + &HC44, ByVal &H83, ByVal 0&
    SetTimer GetProp(GetDesktopWindow, "HWND"), 0&, 1, AddressOf TimerProc  

End Sub
 
Sub UnSubClassExcel(hwnd As Long)

    SetWindowLong hwnd, GWL_WNDPROC, lOldWinProc
    RemoveProp GetDesktopWindow, "HWND"  
    lOldWinProc = 0

End Sub
 
Private Function WindowProc( _
    ByVal hwnd As Long, ByVal uMsg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long

    On Error Resume Next

    Select Case uMsg
        Case WM_MOVE
            UserForm1.TextBox1 = Application.Top & vbTab & Application.Left
            DoEvents

        'Case WM_EXITSIZEMOVE  
        '    UserForm1.TextBox1 = Application.Top & vbTab & Application.Left  
        '    DoEvents  

    End Select

    WindowProc = CallWindowProc(lOldWinProc, hwnd, uMsg, wParam, lParam)

End Function
 
 
Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, _
    ByVal uElapse As Long, ByVal lpTimerFunc As Long)

    lVBEhwnd = FindWindow(VBE_CLASS_NAME, vbNullString)
    KillTimer GetProp(GetDesktopWindow, "HWND"), 0&  
    SendMessage GetDesktopWindow, WM_SETREDRAW, ByVal 1, 0&
    ShowWindow lVBEhwnd, 0&
    LockWindowUpdate 0&
    lOldWinProc = SetWindowLong _
    (GetProp(GetDesktopWindow, "HWND"), _  
    GWL_WNDPROC, AddressOf WindowProc)

End Sub

In "Modul2" die Prozedur, um das Ganze anzuschubsen:
Option Explicit

Sub UF_show()
    UserForm1.Show vbModeless
End Sub

In "DieseArbeitsmappe":
Option Explicit
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call UnSubClassExcel(Application.hwnd)
End Sub

In "UserForm1":
Option Explicit

Private Sub UserForm_Activate()
    Me.TextBox1 = Application.Top & vbTab & Application.Left
    Call Safe_Subclass(Application.hwnd)
    Application.OnTime Now + TimeValue("00:00:00"), "UF_show"  
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Call UnSubClassExcel(Application.hwnd)
End Sub

Private Sub UserForm_Deactivate()
    Call UnSubClassExcel(Application.hwnd)
End Sub

Nun solltest du folgendes feststellen:
Wenn du das Excelfenster unter dem Formular bewegst, sollte im Textfeld des Formulars die Position des Excelfensters angezeigt werden.

Ich hoffe bei dir funktioniert das auch so wie bei mir (Excel 2003 auf Win7 x86).

Grüße
rubberman
Member: miniversum
miniversum Oct 28, 2012 at 18:25:28 (UTC)
Goto Top
Hallo rubberman und danke für die Idee. Das hilft mir schon sehr weiter.
Mit subclassing habe ich es auch versucht, allerdings dann wieder verworfen weil ich es nicht annährend funktionieren hinbekommen habe.

Nun habe ich es so hinbekommen wie ich es wollte. Danke für die Hilfe.

miniversum
Member: miniversum
miniversum Oct 30, 2012 at 10:35:56 (UTC)
Goto Top
Hallo nochmal.

Leider hat es nach mehreren Tests und integriert in meinem (größeren) Projekt doch nicht stabil funktioniert.
Allerdings habe ich eine andere Möglichkeit gefunden.
Ich benutze nun den Befehl SetParent aus der Windows API.
Einzige Einschränkung ist hierbei, das die Form nur innerhalb des Excelfensters verschiebbar ist, was in meinem Fall allerdings nicht so dramatisch sein sollte.

In einer Form fügt man einfach folgenden Code ein:
Private Declare Function SetParent Lib "user32" ( _  
    ByVal hWndChild As Long, _
    ByVal hWndNewParent As Long) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _  
    (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long

Private Declare Function GetAncestor Lib "user32.dll" ( _  
    ByVal hwnd As Long, _
    ByVal gaFlags As Long) As Long


Private Sub UserForm_Initialize()
    Const C_VBA6_USERFORM_CLASSNAME = "ThunderDFrame"  
    Const GA_ROOTOWNER As Long = 3&

    Dim AppHWnd As Long
    Dim UserFormHWnd As Long
    Dim Res As Long
    ''''''''''''''''''''''''''''''  
    ' Get the HWnd of the UserForm  
    ''''''''''''''''''''''''''''''  
    UserFormHWnd = FindWindow(C_VBA6_USERFORM_CLASSNAME, Me.Caption)
    If UserFormHWnd > 0 Then
        ''''''''''''''''''''''''  
        ' Get the ROOTOWNER HWnd  
        ''''''''''''''''''''''''  
        AppHWnd = GetAncestor(UserFormHWnd, GA_ROOTOWNER)
        If AppHWnd > 0 Then
            '''''''''''''''''''''''''''''''''  
            ' Call SetParent to make the form  
            ' a child of the application.  
            '''''''''''''''''''''''''''''''''  
            Res = SetParent(UserFormHWnd, AppHWnd)
            If Res = 0 Then
                ''''''''''''''''''''  
                ' An error occurred.  
                ''''''''''''''''''''  
                MsgBox "The call to SetParent failed."  
            End If
        End If
    End If

End Sub
Details und eine Demo ist hier zu finden: http://www.cpearson.com/excel/SetParent.aspx

mfg
miniversum
Member: rubberman
rubberman Oct 30, 2012 at 17:39:48 (UTC)
Goto Top
Hallo miniversum.

Daran hatte ich auch schon gedacht, allerdings hatte nicht geglaubt, dass das für dich infrage kommt. Das Formular wir so immer einen Teil der Tabelle verdecken, da es in das Application Fenster integriert ist.

Egal. Einfacher ist es so in jedem Fall und stabiler als das Subclassing erst recht. Danke fürs Teilen deiner Lösung face-smile

Grüße
rubberman
GermansolvedQuestionVB for ApplicationsDevelopment
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 5 CommentsjstrickerWireguard VPN on UDM Pro behind Fritzbox - Handshake did not completejstricker - 3 Comments