Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1720to1724
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Monitore erkennen
18.11.2019 10:44:49
Anja
Hallo zusammen,
gibt es eine Möglichkeit per vba zwei angeschlossene Monitore zu erkennen und per vba anzusprechen?
Danke.
VG Anja

16
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Nein, für was auch? (owT)
18.11.2019 11:57:06
EtoPHG

AW: Monitore erkennen
18.11.2019 12:06:55
Nepumuk
Hallo Anja,
ja das geht. Was hast du den vor?
Gruß
Nepumuk
AW: Monitore erkennen
18.11.2019 23:30:44
Anja
Hallo Nepumuk,
das wäre natürlich super. Es geht immer noch um mein Programm, welches die Zeit und Wertungen beim Wettkampf nimmt. Ich habe einen Monitor für die Bedienung und den zweiten für die Zuschauer. Die Darstellungen sind unterschiedlich, aber miteinander verknüpft (z.B. die Stoppuhr/Wertungen usw.)Nun habe ich auch Steuerelemente, um beispielsweise zu Beginn des Kampfes die Kämpfer oder das Gewicht auswählen zu können. Jetzt ist es so, dass ich ein Tabellenblatt erstellt habe, auf dem sich die "Bedien-Uhr" und die "Zuschauer-Uhr" befinden. Mit der Projizierung "Erweitern" kann ich dann die "Bedien-Uhr" auf dem einen und die "Zuschauer-Uhr" auf dem anderern Monitor sehen. Da ich nun aber auch schon mal ein anderes Tabellenblatt öffnen muss, möchte ich nicht, dass die Zuschauer die Uhr "verlieren", deshalb habe ich ein zweites Fenster also ein zweites windows(2) auf dem zweiten Bildschirm. Dieses windows(2) verhält sich aber anders als das windows(1). Dort kann ich z.B. die Stuerelemente nicht anwählen. Darum soll windows (2) auch immer nur auf dem Zuschauer-Monitor bleiben.
Und hier ist das Problem. Wenn ich die beiden Bildschirme per vba einrichte, schiebt er mir meistens das windows(1) auf den Zuschauer-Monitor. Wenn ich den gleichen Befehl noch einmal ausführe tauscht er im günstigsten Fall die Monitore. Beim nochmaligen Ausführen werden beide windows (1) und (2) Fenster auf einen Monitor dargestellt. Ich erkenne da keine Regel, wonach das ausgeführt wird. Deshalb würde ich gerne einen Befehl haben, der sagt schieb mir windows(2) auf Monitor(2) und schieb mir windows(1) auf Monitor (1).
Mit dem untenstehenden Code (da hattest du mir glaub ich auch schon geholfen :-), richte ich bei de Bildeschirme für die entsprechenden Bereiche und Größen ein. Wie gesagt es funktioniert, bis auf die Tatsache, dass meistens die falschen Monitore angesprochen werden. Hat vielleicht damit zu tun in welchem Stadium ich das Programm speichere, ob dann 1 oder zwei Fenster geöffnet sind. Ich hab das schon ausprobiert zu variieren, aber komme da gar nicht weiter.
Vielen Dank.
Anja
Sub TestBeide_Bildschirme_einstellen()
'alle doppelten Dateien ausblenden und zweiten Bildschirm einrichten
Dim OrigW As Window, KlonW As Window
Dim ShJudoTimer As Worksheet, j
'Schließen aller Fenster von Thisworkbook bis auf 2
With ThisWorkbook
.Activate
If .Windows.Count 

Anzeige
AW: Monitore erkennen
19.11.2019 10:36:22
Nepumuk
Hallo Anja,
du musst dich bis morgen gedulden, erst dann habe ich einen zweiten Monitor.
Gruß
Nepumuk
AW: Monitore erkennen
20.11.2019 12:20:09
Anja
Hallo Nepumuk,
wenn es für dich Sinn macht, könnte ich dir auch das ges. Programm zuschicken. Wäre vielleicht einfacher, als immer weit auszuholen und zu erklären.
Danke.
Anja
AW: Monitore erkennen
20.11.2019 17:02:42
Nepumuk
Hallo Anja,
folgenden Code in ein Standardmodul (Menüleiste im VBA-Editor - Einfügen - Modul)
Option Explicit

Private Declare Function EnumDisplayMonitors Lib "user32.dll" ( _
    ByVal hdc As Long, _
    ByRef lprcClip As Any, _
    ByVal lpfnEnum As Long, _
    ByVal dwData As Long) As Long
Private Declare Function GetMonitorInfoA Lib "user32.dll" ( _
    ByVal hMonitor As Long, _
    ByRef lpmi As MONITORINFO) As Long
Private Declare Function MonitorFromWindow Lib "user32.dll" ( _
    ByVal hwnd As Long, _
    ByVal dwFlags As Long) As Long

Private Type RECT
    lngLeft As Long
    lngTop As Long
    lngRight As Long
    lngBottom As Long
End Type

Private Type MONITORINFO
    cbSize As Long
    rcMonitor As RECT
    rcWork As RECT
    dwFlags As Long
End Type

Private Const MONITOR_DEFAULTTONEAREST = &H2

Private ludtRect As RECT
Private lblnSecondMonitor As Boolean

Public Sub MoveWindow()
    
    Dim udtDeleteRect As RECT
    
    ludtRect = udtDeleteRect
    lblnSecondMonitor = False
    
    Call EnumDisplayMonitors(ByVal 0&, ByVal 0&, AddressOf Read_Monitor, ByVal 0&)
    
    If lblnSecondMonitor Then
        
        With ThisWorkbook.Windows(1)
            
            .WindowState = xlNormal
            .Left = ludtRect.lngLeft
            .Top = ludtRect.lngTop
            .WindowState = xlMaximized
            
        End With
    Else
        Call MsgBox("Keinen 2. Bildschirm gefunden.", vbExclamation, "Hinweis")
    End If
End Sub

Private Function Read_Monitor( _
        ByVal pvlngMonitor As Long, _
        ByVal pvlngHdcMonitor As Long, _
        ByRef prudtlprcMonitor As RECT, _
        ByVal pvlngdwData As Long) As Long

    
    Dim udtMonitorInfo As MONITORINFO
    
    udtMonitorInfo.cbSize = Len(udtMonitorInfo)
    
    Call GetMonitorInfoA(pvlngMonitor, udtMonitorInfo)
    
    If MonitorFromWindow(Application.hwnd, MONITOR_DEFAULTTONEAREST) = pvlngMonitor Then
        
        Read_Monitor = 1
        
    Else
        
        lblnSecondMonitor = True
        
        ludtRect = udtMonitorInfo.rcWork
        
        Read_Monitor = 0
        
    End If
End Function

Einfach in deinem Code die Prozedur "MoveWindow" aufrufen.
Gruß
Nepumuk
Anzeige
AW: Monitore erkennen
20.11.2019 17:38:09
Anja
Oh Mann, es funktioniert! Du bist ja echt genial!
So kann ich tatsächlich, wenn die Bildschirme falsch eingestellt sind, wieder umswitchen!
Vielen lieben Dank für deine ganze Arbeit!
Dankbare Grüße Anja
ziemlich cool! Zusatzfrage:
21.11.2019 09:01:06
Klaus
Hallo Nepumuk,
das ist ja ziemlich cool! Zusatzfrage: Kann ich damit auch eine UserForm zwingend auf Monitor 1 anzeigen, idealerweise zentriert? Meine Userforms gehen immer auf Monitor 2 unten in der Ecke auf ...
LG,
Klaus
AW: ziemlich cool! Zusatzfrage:
21.11.2019 11:36:13
Nepumuk
Hallo Klaus,
soll das Userform auf dem Bildschirm erscheinen auf dem sich auch Excel befindet?
Gruß
Nepumuk
AW: ziemlich cool! Zusatzfrage:
21.11.2019 12:06:17
Klaus
ja.
LG,
Klaus M.
Anzeige
AW: ziemlich cool! Zusatzfrage:
21.11.2019 12:33:50
Nepumuk
Hallo Klaus,
im Modul des Userforms:
Private Sub UserForm_Initialize()
    Call MoveUserform(Me)
End Sub

in einem Standardmodul:
Option Explicit

Private Declare Function EnumDisplayMonitors Lib "user32.dll" ( _
    ByVal hdc As Long, _
    ByRef lprcClip As Any, _
    ByVal lpfnEnum As Long, _
    ByVal dwData As Long) As Long
Private Declare Function GetMonitorInfoA Lib "user32.dll" ( _
    ByVal hMonitor As Long, _
    ByRef lpmi As MONITORINFO) As Long
Private Declare Function MonitorFromWindow Lib "user32.dll" ( _
    ByVal hwnd As Long, _
    ByVal dwFlags As Long) As Long

Private Type RECT
    lngLeft As Long
    lngTop As Long
    lngRight As Long
    lngBottom As Long
End Type

Private Type MONITORINFO
    cbSize As Long
    rcMonitor As RECT
    rcWork As RECT
    dwFlags As Long
End Type

Private Const MONITOR_DEFAULTTONEAREST As Long = &H2

Private ludtRect As RECT

Public Sub MoveUserform(ByRef probjUserform As Object)
    Call EnumDisplayMonitors(ByVal 0&, ByVal 0&, AddressOf Read_Monitor, ByVal 0&)
    With probjUserform
        Call .Move((ludtRect.lngLeft + ludtRect.lngRight) * 0.75 / 2 - .Width / 2 _
            , (ludtRect.lngBottom + ludtRect.lngTop) * 0.75 / 2 - .Height / 2)
    End With
End Sub

Private Function Read_Monitor( _
        ByVal pvlngMonitor As Long, _
        ByVal pvlngHdcMonitor As Long, _
        ByRef prudtlprcMonitor As RECT, _
        ByVal pvlngdwData As Long) As Long

    Dim udtMonitorInfo As MONITORINFO
    udtMonitorInfo.cbSize = Len(udtMonitorInfo)
    Call GetMonitorInfoA(pvlngMonitor, udtMonitorInfo)
    If MonitorFromWindow(Application.hwnd, MONITOR_DEFAULTTONEAREST) = pvlngMonitor Then
        ludtRect = udtMonitorInfo.rcWork
        Read_Monitor = 0
    Else
        Read_Monitor = 1
    End If
End Function

Gruß
Nepumuk
Anzeige
AW: ziemlich cool! Zusatzfrage:
21.11.2019 13:08:00
Klaus
Sehr geil, Nepumuk!
Die Userform ist im richtigen Fenster, allerdings ganz links und nicht mittig.
Jetzt musst du mir bitte diese Zeile erklären:
Call .Move((ludtRect.lngLeft + ludtRect.lngRight) * 0.75 / 2 - .Width / 2 _
, (ludtRect.lngBottom + ludtRect.lngTop) * 0.75 / 2 - .Height / 2)
Ich nehme an, da wird die Position des Fensters festgelegt? Was muss ich ändern, um an die Mitte von Monitor 1 zu kommen?
LG,
Klaus
AW: ziemlich cool! Zusatzfrage:
21.11.2019 13:12:25
Nepumuk
Hallo Klaus,
kann ich nicht nachvollziehen. Bei mir liegt das Userform genau in der Mitte.
Versuch mal an Stelle von:
ludtRect = udtMonitorInfo.rcWork
das:
ludtRect = udtMonitorInfo.rcMonitor
Gruß
Nepumuk
Anzeige
AW: ziemlich cool! Zusatzfrage:
21.11.2019 14:15:31
Klaus
Hi Nepumuk,
Nö - bleibt auf Monitor 1 ganz links kleben.
Ist es von belang, dass mein Monitor 1 ein "richtiger" Monitor ist und mein Monitor 2 ist mein Laptop-Screen?
Ich vermute (so weit ich die Codezeile interpretiere) wird die WIDTH und HEIGHT Des Monitors halbiert - vielleicht landet das Fenster genau in der Mitte zwischen beiden summierten Monitorauflösungen?
Es ist nicht von prio, dass das Fenster zentriert wird. Dass es jetzt auf dem richtigen Monitor erscheint ist schon ziemlich cool, vielen Dank!
LG,
Klaus M.
AW: ziemlich cool! Zusatzfrage:
21.11.2019 14:43:23
Nepumuk
Hallo Klaus,
nein, udtMonitorInfo.rcMonitor liefert die Auflösung des Monitors in Pixel (darum *0.75 und sie in Punkt umzuwandeln). Hast du eventuell in den Einstellungen die Skalierung geändert?
Gruß
Nepumuk
Anzeige
AW: ziemlich cool! Zusatzfrage:
22.11.2019 06:20:08
Klaus
Hi und guten Morgen,
nein ich habe keine Skalierungen geändert.
Das Script funktioniert auch und zeigt die Userform mittig - beim Kollegen, bei mir nicht. Witzig: Wenn ich das Excel-Fenster auf meinen kleinen Laptopmonitor ziehe, erscheint dort die Userform mittig. Nur auf dem großen Hauptmonitor klebt sie links.
Bitte steck hier keine Energie mehr rein, Nepumuk. Die Lösung funktioniert für mich 1a.
LG,
Klaus M.
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige