Monitore erkennen

Anja · 2019-11-18T10:44:49+00:00

Hallo zusammen, gibt es eine Möglichkeit per vba zwei angeschlossene Monitore zu erkennen und per vba anzusprechen? Danke. VG 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

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

Forumthread: Monitore erkennen

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial