Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1976to1980
1976to1980
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Bildschirm teilen für Excel und Edge

Forumthread: Bildschirm teilen für Excel und Edge

Bildschirm teilen für Excel und Edge
01.06.2024 18:58:58
Oisse
Hallo Zusammen,
ich möchte gerne folgendes realisieren:
Wenn sich eine UserForm öffnet, soll die Excelmappe auf die linke Bildschirmhälfte minimiert werden und gleichzeitig soll sich auf der rechten Bildschirmhälfte Microsoft Edge öffnen.
Wie muss der Code hierfür aussehen?

Folgendes habe ich bisher: 
' Modulcode: modWindowManagement



#If VBA7 Then

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

    Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

#Else

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

    Private 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

#End If



Const SWP_NOZORDER As Long = &H4

Const SWP_SHOWWINDOW As Long = &H40


Diese Zeilen: 
' 

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

    Private 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

werden mir rot angezeigt.

Auch bei diesem Code: 
Private Sub AdjustWindows()

    Dim hwndExcel As LongPtr

    Dim hwndEdge As LongPtr

    Dim edgePath As String

    Dim result As Long

    Dim screenWidth As Long

    Dim screenHeight As Long



    ' Bildschirmbreite und -höhe

    screenWidth = Application.UsableWidth

    screenHeight = Application.UsableHeight



    ' Fenstergriff der Excel-Anwendung ermitteln

    hwndExcel = FindWindow("XLMAIN", Application.Caption)



    ' Excel-Fenster auf die linke Bildschirmhälfte setzen

    result = SetWindowPos(hwndExcel, 0, 0, 0, screenWidth / 2, screenHeight, SWP_NOZORDER Or SWP_SHOWWINDOW)



    ' Pfad zu Microsoft Edge (anpassen, falls notwendig)

    edgePath = "C:\Program Files (x86)\Microsoft\Edge\Application\msedge.exe"



    ' Microsoft Edge starten

    Shell edgePath, vbNormalFocus



    ' Kurze Pause, um Edge Zeit zum Starten zu geben

    Application.Wait (Now + TimeValue("0:00:03"))



    ' Fenstergriff von Microsoft Edge ermitteln

    hwndEdge = FindWindow("Chrome_WidgetWin_1", vbNullString)



    ' Edge-Fenster auf die rechte Bildschirmhälfte setzen

    result = SetWindowPos(hwndEdge, 0, screenWidth / 2, 0, screenWidth / 2, screenHeight, SWP_NOZORDER Or SWP_SHOWWINDOW)

End Sub


kommt hier: 
  ' Fenstergriff der Excel-Anwendung ermitteln

    hwndExcel = FindWindow("XLMAIN", Application.Caption)

eine Fehlermeldung
Anzeige

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bildschirm teilen für Excel und Edge
01.06.2024 19:29:50
volti
Hallo Oisse,

das ist normal, dass bei 64 Bit-Excel die Declares für32 Bit rot angezeigt werden. Die laufen ja auch nicht in 64 Bit. Also alles ok.

Dann musst Du die Handle aber auch nach 32/64-Bit abgrenzen, sonst gibt es Probleme bei 32 Bit.

Ggf. reicht für das Excel-Handle bei neueren Rechners auch Application.hWnd. So dass hwndExcel = FindWindow("XLMAIN", Application.Caption) enfallen könnte.

Bitte bei 32-Bit noch mal prüfen. Habe vergessen, ob es da auch schon funktioniert.

Ungetesteter Vorschlag: 

Option Explicit



#If VBA7 Then

    Private Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

    Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

    Dim hwndExcel As LongPtr

    Dim hwndEdge As LongPtr

#Else

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

    Private 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

    Dim hwndEdge As Long

#End If



Const SWP_NOZORDER As Long = &H4

Const SWP_SHOWWINDOW As Long = &H40



Private Sub AdjustWindows()

    Dim edgePath As String

    Dim result As Long

    Dim screenWidth As Long

    Dim screenHeight As Long



    ' Bildschirmbreite und -höhe

    screenWidth = Application.UsableWidth

    screenHeight = Application.UsableHeight



    ' Excel-Fenster auf die linke Bildschirmhälfte setzen

    result = SetWindowPos(Application.hwnd, 0, 0, 0, screenWidth / 2, screenHeight, SWP_NOZORDER Or SWP_SHOWWINDOW)



    ' Pfad zu Microsoft Edge (anpassen, falls notwendig)

    edgePath = "C:\Program Files (x86)\Microsoft\Edge\Application\msedge.exe"



    ' Microsoft Edge starten

    Shell edgePath, vbNormalFocus



    ' Kurze Pause, um Edge Zeit zum Starten zu geben

    Application.Wait (Now + TimeValue("0:00:03"))



    ' Fenstergriff von Microsoft Edge ermitteln

    hwndEdge = FindWindowA("Chrome_WidgetWin_1", vbNullString)



    ' Edge-Fenster auf die rechte Bildschirmhälfte setzen

    result = SetWindowPos(hwndEdge, 0, screenWidth / 2, 0, screenWidth / 2, screenHeight, SWP_NOZORDER Or SWP_SHOWWINDOW)

End Sub


Gruß
Karl-Heinz
Anzeige
AW: Bildschirm teilen für Excel und Edge
01.06.2024 20:39:44
Oisse
Hallo Karl Heinz,
vielen Dank, für Deine Hilfe. Es klappt soweit.
D. h. es wird das Excelfenster verkleinert, allerdings auf ein Viertel und zwar in der linken oberen Ecke.
Edge wird geöffnet allerdings über den gesamten Bildschirm.
Was muss ich hier noch ändern?
L.G.
Oisse
AW: Bildschirm teilen für Excel und Edge
01.06.2024 22:56:49
volti
Hallo Oisse,

hier ein weiterer Vorschlag, eine weitere Idee.

Allerdings gibt es Schwierigkeiten beim Ermitteln des Edge-Handles mittels der Klasse.
Bei mir wird z.B. öfters Skype gefunden, das offensichtlich geladen aber nicht sichtbar ist. Die Findwindow-Funktion holt in der Schleife immer wieder das gleiche Handle und lässt auch keinen Suchtext mit * für das Caption zu.
Im Worstcase müsste man alle Fenster durchgehen und anhand Klasse und Fenstertext das richtige Handle ermitteln.

Probiere es einfach mal aus... 

Code:


Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function FindWindowA Lib "user32" ( _
            ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function SetWindowPos Lib "user32" ( _
            ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, _
            ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, _
            ByVal wFlags As Long) As Long
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" ( _
            ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function ShowWindow Lib "user32" ( _
            ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
    Dim hwndEdge As LongPtr
#Else
    Private Declare Function FindWindowA Lib "user32"  ( _
            ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private 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
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare  Function GetSystemMetrics Lib "user32" ( _
            ByVal nIndex As Long) As Long
    Private Declare Function ShowWindow Lib "user32" ( _
            ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    Dim hwndEdge As Long
#End If

Private Sub AdjustWindows()
  Dim i As Long, cx As Long, cy As Long
  Const ciParam As Long = &H40 ' SWP_SHOWWINDOW

' Excel-Fenster auf die linke Bildschirmhälfte setzen
  cx = GetSystemMetrics(0) \ 2: cy = GetSystemMetrics(1)
  SetWindowPos Application.hwnd, 0, 0, 0, cx, cy, ciParam
    
' Microsoft Edge starten (Pfad anpassen, falls notwendig)
  Shell "C:\Program Files (x86)\Microsoft\Edge\Application\msedge.exe", vbNormalFocus

' Edge-Fenster auf die rechte Bildschirmhälfte setzen
  Do
     i = i + 1: If i > 100 Then Exit Sub
     hwndEdge = FindWindowA("Chrome_WidgetWin_1", vbNullString)
     Sleep 100
  Loop Until hwndEdge <> 0
  ShowWindow hwndEdge, 1
  SetWindowPos hwndEdge, 0, cx, 0, cx, cy, ciParam
End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz
Anzeige
AW: Bildschirm teilen für Excel und Edge
03.06.2024 12:45:39
Oisse
Hallo Karl-Heinz,
und vielen herzlichen Dank.
Vielleicht darf ich dich nochmal bemühen:
Wie muss denn der code aussehen, um abzufragen, ob Edge bereits geöffnet ist.
Mal zur Erklärung:
Da Outlook das Exchange-Protokoll nicht unterstützt und Windows-Mail bald wegfällt, habe ich mir gedacht, ich löse das Problem, indem ich aus Excel heraus jeweils eine UserForm kreiere um mir die Email-Adresse, den Betreff und den Text anzeigen zu lassen und per Button soll mir der jeweilige Wert in die Zwischenablage kopiert werden.
Das funktioniert auch alles.
Damit ich allerdings nicht ständig zwischen Excel und Edge hin und her wechseln muss, wollte ich Excel links und Edge rechts auf dem Bildschirm haben, damit auch die UserForms noch schön angezeigt werden.
Nun ergibt es natürlich keinen Sinn, wenn ich Edge bereits geöffnet habe, dass ich es erneut öffne, wenn ich eine neue Email versenden will.
Deshalb hätte ich eben gerne abgefragt: Wenn es nicht geöffnet ist, öffne es, ansonsten setze es auf die rechte Seite.
Aber irgendwie bekomme ich das nicht hin.
Gruß Oisse
Anzeige
AW: Bildschirm teilen für Excel und Edge
04.06.2024 12:38:27
volti
Hallo Oisse,

Du brauchst doch nur den Shell-Befehl in eine FindWindow-Function-Ifabfrage setzen. 

If FindWindowA("Chrome_WidgetWin_1", vbNullString)=0 then Shell......



Aber wie gesagt, wenn das nicht eindeutig genug sein sollte habe ich hier noch einen früheren Code von mir, der Fenster anhand Klasse und/oder Windowtext incl. Sternchensuche holt.
Ist natürlich dann auch etwas aufwändiger.

PS: Der Code ist jetzt für neues Excel 32/64-Bit (VBA7) und altes Excel 32-Bit (VBA6). Stellt sich mir die Frage, ob bei euch noch so alte Excelversionen vorhanden sind? 

Code:


#If VBA7 Then
 Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 Private Declare PtrSafe Function SetWindowPos Lib "user32" ( _
         ByVal hWnd As LongPtr, ByVal hWndInsertAfter As LongPtr, _
         ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, _
         ByVal wFlags As Long) As Long
 Private Declare PtrSafe Function GetSystemMetrics Lib "user32" ( _
         ByVal nIndex As Long) As Long
 Private Declare PtrSafe Function EnumWindows Lib "user32" ( _
         ByVal lpEnumFunc As LongPtr, ByVal lparam As LongPtr) As Long
 Private Declare PtrSafe Function EnumChildWindows Lib "user32" ( _
         ByVal hWndParent As LongPtr, ByVal lpEnumFunc As LongPtr, _
         ByVal lparam As LongPtr) As Long
 Private Declare PtrSafe Function GetWindowTextA Lib "user32" ( _
         ByVal hWnd As LongPtr, ByVal lpString As String, _
         ByVal cch As Long) As Long
 Private Declare PtrSafe Function GetClassNameA Lib "user32" ( _
         ByVal hWnd As LongPtr, ByVal lpClassName As String, _
         ByVal nMaxCount As Long) As Long
 
 Private Type GetWndParam_STRUCT
    hWnd         As LongPtr
    sWindowTitle As String
    sClassname   As String
 End Type

#Else
 Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 Private 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
 Private Declare Function GetSystemMetrics Lib "user32" ( _
         ByVal nIndex As Long) As Long
 Private Declare Function EnumWindows Lib "user32" ( _
         ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
 Private Declare Function EnumChildWindows Lib "user32" ( _
         ByVal hWndParent As Long, ByVal lpEnumFunc As Long, _
         ByVal lParam As Long) As Long
 Private Declare Function GetWindowTextA Lib "user32" ( _
         ByVal hwnd As Long, ByVal lpString As String, _
         ByVal cch As Long) As Long
 Private Declare Function GetClassNameA Lib "user32" ( _
         ByVal hwnd As Long, ByVal lpClassName As String, _
         ByVal nMaxCount As Long) As Long
 
 Private Type GetWndParam_STRUCT
    hWnd         As Long
    sWindowTitle As String
    sClassname   As String
 End Type
 
#End If
Dim tParams As GetWndParam_STRUCT

#If VBA7 Then
 Function GetWindowLike(sWindowTitle As String, sClassname As String) As LongPtr
#Else
 Function GetWindowLike(sWindowTitle As String, sClassname As String) As Long
#End If
' Ermittelt das Handle eines Fensters anhand eines Teiltextes und /oder  Klasse
  With tParams
     .sWindowTitle = sWindowTitle                       ' Suchtext übernehmen
     .sClassname = sClassname                           ' Suchklasse übernehmen
     .hWnd = 0
     Call EnumWindows(AddressOf EnumWindowProc, VarPtr(tParams))
     GetWindowLike = .hWnd                              ' Gefundenes Handle zurückgeben
  End With
End Function

#If VBA7 Then
 Private Function EnumWindowProc(ByVal hWnd As LongPtr, _
                                 lparam As GetWndParam_STRUCT) As Long
#Else
 Private Function EnumWindowProc(ByVal hWnd As Long, _
                                 lparam As GetWndParam_STRUCT) As Long
#End If
  Dim sText As String * 255
  
  With lparam
     Call GetClassNameA(hWnd, sText, 255)              ' Klassenamen holen
     If Left$(sText, InStr(sText, vbNullChar) - 1) Like .sClassname Then
        Call GetWindowTextA(hWnd, sText, 255)          ' Fenstertext holen
        If Left$(sText, InStr(sText, vbNullChar) - 1) Like .sWindowTitle Then
           lparam.hWnd = hWnd                          ' Handle übernehmen
           EnumWindowProc = 0: Exit Function
        End If
     End If
  End With
  EnumWindowProc = 1
 End Function
 
 
Private Sub AdjustWindows()
  Dim cx As Long, cy As Long
 
  cx = GetSystemMetrics(0) \ 2: cy = GetSystemMetrics(1)    ' Bildschirmgrößen holen
  SetWindowPos Application.hWnd, 0, 0, 0, cx, cy, &H40      ' &H40=SWP_SHOWWINDOW
    
' Microsoft Edge starten (Pfad anpassen, falls notwendig)
  If GetWindowLike("*Edge", "Chrome_WidgetWin_1") = 0 Then
     Shell "C:\Program Files (x86)\Microsoft\Edge\Application\msedge.exe", 1
     Sleep 3000
  End If

' Ermittelt das Handle eines Fensters anhand eines Teiltextes
  If GetWindowLike("*Edge", "Chrome_WidgetWin_1") > 0 Then
     ShowWindow tParams.hWnd, 1                             ' 1=SW_NORMAL
     SetWindowPos tParams.hWnd, 0, cx, 0, cx, cy, &H40      ' &H40=SWP_SHOWWINDOW
  End If
End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz
Anzeige
Dankeschön für die Hilfe
06.06.2024 09:30:59
Oisse
Lieber Karl-Heinz,
hab vielen herzlichen Dank für Deine super Hilfe.
Alles Gute
Oisse
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige