Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Move Event des Application Fenster gesucht

Frage Entwicklung VB for Applications

Mitglied: miniversum

miniversum (Level 3) - Jetzt verbinden

22.10.2012, aktualisiert 12:16 Uhr, 2535 Aufrufe, 4 Kommentare

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:
01.
Private Sub UserForm_Layout() 
02.
    Debug.Print Me.Top, Me.Left, Me.Height, Me.Width 
03.
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
Mitglied: rubberman
27.10.2012 um 19:02 Uhr
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":
01.
Option Explicit 
02.
 
03.
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _ 
04.
    ByVal hwnd As Long, _ 
05.
    ByVal nIndex As Long, _ 
06.
    ByVal dwNewLong As Long) As Long 
07.
  
08.
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ( _ 
09.
    ByVal lpPrevWndFunc As Long, _ 
10.
    ByVal hwnd As Long, _ 
11.
    ByVal MSG As Long, _ 
12.
    ByVal wParam As Long, _ 
13.
    ByVal lParam As Long) As Long 
14.
 
15.
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _ 
16.
    ByVal lpClassName As String, _ 
17.
    ByVal lpWindowName As String) As Long 
18.
 
19.
Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long 
20.
 
21.
Private Declare Function ShowWindow Lib "user32.dll" ( _ 
22.
    ByVal hwnd As Long, _ 
23.
    ByVal nCmdShow As Long) As Long 
24.
 
25.
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _ 
26.
    ByVal hwnd As Long, _ 
27.
    ByVal wMsg As Long, _ 
28.
    ByVal wParam As Long, _ 
29.
    ByRef lParam As Any) As Long 
30.
 
31.
Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" ( _ 
32.
    ByVal hwnd As Long, _ 
33.
    ByVal wMsg As Long, _ 
34.
    ByVal wParam As Long, _ 
35.
    ByVal lParam As Long) As Long 
36.
 
37.
Private Declare Function SetTimer Lib "user32.dll" ( _ 
38.
    ByVal hwnd As Long, _ 
39.
    ByVal nIDEvent As Long, _ 
40.
    ByVal uElapse As Long, _ 
41.
    ByVal lpTimerFunc As Long) As Long 
42.
 
43.
Private Declare Function KillTimer Lib "user32.dll" ( _ 
44.
    ByVal hwnd As Long, _ 
45.
    ByVal nIDEvent As Long) As Long 
46.
 
47.
Private Declare Function LockWindowUpdate Lib "user32.dll" ( _ 
48.
    ByVal hwndLock As Long) As Long 
49.
 
50.
Private Declare Function GetProp Lib "user32" Alias "GetPropA" ( _ 
51.
    ByVal hwnd As Long, _ 
52.
    ByVal lpString As String) As Long 
53.
 
54.
Private Declare Function SetProp Lib "user32" Alias "SetPropA" ( _ 
55.
    ByVal hwnd As Long, _ 
56.
    ByVal lpString As String, _ 
57.
    ByVal hData As Long) As Long 
58.
 
59.
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" ( _ 
60.
    ByVal hwnd As Long, _ 
61.
    ByVal lpString As String) As Long 
62.
 
63.
Private Const GWL_WNDPROC   As Long = -4 
64.
Private Const WM_USER As Long = &H400 
65.
Private Const WM_MOVE As Long = &H3 
66.
Private Const WM_EXITSIZEMOVE As Long = &H232 
67.
Private Const WM_SETREDRAW As Long = &HB 
68.
 
69.
Private Const VBE_CLASS_NAME As String = "wndclass_desked_gsk" 
70.
Private Const EXCEL_CLASS_NAME As String = "XLMAIN" 
71.
 
72.
Private lOldWinProc As Long 
73.
Private lVBEhwnd As Long 
74.
 
75.
Sub Safe_Subclass(hwnd As Long) 
76.
  
77.
    If GetProp(GetDesktopWindow, "HWND") <> 0 Then 
78.
        Exit Sub 
79.
    End If 
80.
    SetProp GetDesktopWindow, "HWND", hwnd 
81.
    lVBEhwnd = FindWindow(VBE_CLASS_NAME, vbNullString) 
82.
    LockWindowUpdate lVBEhwnd 
83.
    SendMessage GetDesktopWindow, ByVal WM_SETREDRAW, ByVal 0&, 0& 
84.
    PostMessage lVBEhwnd, ByVal WM_USER + &HC44, ByVal &H30, ByVal 0& 
85.
    PostMessage lVBEhwnd, ByVal WM_USER + &HC44, ByVal &H33, ByVal 0& 
86.
    PostMessage lVBEhwnd, ByVal WM_USER + &HC44, ByVal &H83, ByVal 0& 
87.
    SetTimer GetProp(GetDesktopWindow, "HWND"), 0&, 1, AddressOf TimerProc 
88.
 
89.
End Sub 
90.
  
91.
Sub UnSubClassExcel(hwnd As Long) 
92.
 
93.
    SetWindowLong hwnd, GWL_WNDPROC, lOldWinProc 
94.
    RemoveProp GetDesktopWindow, "HWND" 
95.
    lOldWinProc = 0 
96.
 
97.
End Sub 
98.
  
99.
Private Function WindowProc( _ 
100.
    ByVal hwnd As Long, ByVal uMsg As Long, _ 
101.
    ByVal wParam As Long, ByVal lParam As Long) As Long 
102.
 
103.
    On Error Resume Next 
104.
 
105.
    Select Case uMsg 
106.
        Case WM_MOVE 
107.
            UserForm1.TextBox1 = Application.Top & vbTab & Application.Left 
108.
            DoEvents 
109.
 
110.
        'Case WM_EXITSIZEMOVE 
111.
        '    UserForm1.TextBox1 = Application.Top & vbTab & Application.Left 
112.
        '    DoEvents 
113.
 
114.
    End Select 
115.
 
116.
    WindowProc = CallWindowProc(lOldWinProc, hwnd, uMsg, wParam, lParam) 
117.
 
118.
End Function 
119.
  
120.
  
121.
Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, _ 
122.
    ByVal uElapse As Long, ByVal lpTimerFunc As Long) 
123.
 
124.
    lVBEhwnd = FindWindow(VBE_CLASS_NAME, vbNullString) 
125.
    KillTimer GetProp(GetDesktopWindow, "HWND"), 0& 
126.
    SendMessage GetDesktopWindow, WM_SETREDRAW, ByVal 1, 0& 
127.
    ShowWindow lVBEhwnd, 0& 
128.
    LockWindowUpdate 0& 
129.
    lOldWinProc = SetWindowLong _ 
130.
    (GetProp(GetDesktopWindow, "HWND"), _ 
131.
    GWL_WNDPROC, AddressOf WindowProc) 
132.
 
133.
End Sub
In "Modul2" die Prozedur, um das Ganze anzuschubsen:
01.
Option Explicit 
02.
 
03.
Sub UF_show() 
04.
    UserForm1.Show vbModeless 
05.
End Sub
In "DieseArbeitsmappe":
01.
Option Explicit 
02.
  
03.
Private Sub Workbook_BeforeClose(Cancel As Boolean) 
04.
    Call UnSubClassExcel(Application.hwnd) 
05.
End Sub
In "UserForm1":
01.
Option Explicit 
02.
 
03.
Private Sub UserForm_Activate() 
04.
    Me.TextBox1 = Application.Top & vbTab & Application.Left 
05.
    Call Safe_Subclass(Application.hwnd) 
06.
    Application.OnTime Now + TimeValue("00:00:00"), "UF_show" 
07.
End Sub 
08.
 
09.
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) 
10.
    Call UnSubClassExcel(Application.hwnd) 
11.
End Sub 
12.
 
13.
Private Sub UserForm_Deactivate() 
14.
    Call UnSubClassExcel(Application.hwnd) 
15.
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
Bitte warten ..
Mitglied: miniversum
28.10.2012 um 19:25 Uhr
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
Bitte warten ..
Mitglied: miniversum
30.10.2012 um 11:35 Uhr
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:
01.
Private Declare Function SetParent Lib "user32" ( _ 
02.
    ByVal hWndChild As Long, _ 
03.
    ByVal hWndNewParent As Long) As Long 
04.
 
05.
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ 
06.
    (ByVal lpClassName As String, _ 
07.
    ByVal lpWindowName As String) As Long 
08.
 
09.
Private Declare Function GetAncestor Lib "user32.dll" ( _ 
10.
    ByVal hwnd As Long, _ 
11.
    ByVal gaFlags As Long) As Long 
12.
 
13.
 
14.
Private Sub UserForm_Initialize() 
15.
    Const C_VBA6_USERFORM_CLASSNAME = "ThunderDFrame" 
16.
    Const GA_ROOTOWNER As Long = 3& 
17.
 
18.
    Dim AppHWnd As Long 
19.
    Dim UserFormHWnd As Long 
20.
    Dim Res As Long 
21.
    '''''''''''''''''''''''''''''' 
22.
    ' Get the HWnd of the UserForm 
23.
    '''''''''''''''''''''''''''''' 
24.
    UserFormHWnd = FindWindow(C_VBA6_USERFORM_CLASSNAME, Me.Caption) 
25.
    If UserFormHWnd > 0 Then 
26.
        '''''''''''''''''''''''' 
27.
        ' Get the ROOTOWNER HWnd 
28.
        '''''''''''''''''''''''' 
29.
        AppHWnd = GetAncestor(UserFormHWnd, GA_ROOTOWNER) 
30.
        If AppHWnd > 0 Then 
31.
            ''''''''''''''''''''''''''''''''' 
32.
            ' Call SetParent to make the form 
33.
            ' a child of the application. 
34.
            ''''''''''''''''''''''''''''''''' 
35.
            Res = SetParent(UserFormHWnd, AppHWnd) 
36.
            If Res = 0 Then 
37.
                '''''''''''''''''''' 
38.
                ' An error occurred. 
39.
                '''''''''''''''''''' 
40.
                MsgBox "The call to SetParent failed." 
41.
            End If 
42.
        End If 
43.
    End If 
44.
 
45.
End Sub
Details und eine Demo ist hier zu finden: http://www.cpearson.com/excel/SetParent.aspx

mfg
miniversum
Bitte warten ..
Mitglied: rubberman
30.10.2012 um 18:39 Uhr
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

Grüße
rubberman
Bitte warten ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(6)

Tipp von agowa338 zum Thema Windows 10 ...

Ähnliche Inhalte
Batch & Shell
gelöst PowerShell Script Move-Item nach x Tagen (5)

Frage von lupolo zum Thema Batch & Shell ...

Sonstige Systeme
gelöst Kostenfreies Ticketsystem gesucht (1)

Frage von Stefan007 zum Thema Sonstige Systeme ...

LAN, WAN, Wireless
Software für Backup oder Datensynchronisation über WAN gesucht (4)

Frage von Rubiks zum Thema LAN, WAN, Wireless ...

Windows Server
User-ID zu Application Crash

Frage von pablovic zum Thema Windows Server ...

Heiß diskutierte Inhalte
LAN, WAN, Wireless
gelöst Server erkennt Client nicht wenn er ausserhalb des DHCP Pools liegt (28)

Frage von Mar-west zum Thema LAN, WAN, Wireless ...

Windows Server
Server 2008R2 startet nicht mehr (Bad Patch 0xa) (18)

Frage von Haures zum Thema Windows Server ...

Outlook & Mail
Outlook 2010 findet ost datei nicht (18)

Frage von Floh21 zum Thema Outlook & Mail ...

Netzwerkmanagement
gelöst Anregungen, kleiner Betrieb, IT-Umgebung (17)

Frage von Unwichtig zum Thema Netzwerkmanagement ...