Userform Bildschirmausrichtung

Forumthread: Userform Bildschirmausrichtung

19.12.2019 16:36:51

Joni

Hallo zusammen,
ich brauche etwas Hilfe bei der Platzierung der Userform auf dem Bildschirm. Ich habe eine Userform deren Position auf dem Bildschirm immer gespeichert bzw. geladen wird. Das funktioniert auch gut. Jetzt würde ich aber gerne verhindern, dass die Userform über den Bildschirmrand hinaus verschoben wird, bzw. genauer gesagt, beim nächsten Laden dann wieder am Rand ausgerichtet wird. Das auch dann, wenn der User 2 Bildschirme hat. Dazu ein paar Gedanken.
UF links (tlw.) außerhalb des Bildschirms -- sollte beim neu Laden, dann links am Bildschirmrand ausgerichtet werden
UF oben (tlw.) außerhalb des Bildschrims -- sinngemäß wie bei links -- hier müsste 0 als Top funktionieren (siehe unten 2 Bildschirme)
Letzer Bildschrim war groß (zB Büro) aktueller Bildschirm ist klein (zB Laptop) -- UF könnte ganz außerhalb sein
2 Bildschirme vorhanden, wenn rechts der Hauptbildschirm ist, dann ist links immer ein negativer Wert für die Position der UF vorhanden (sonst könnte ich ja einfach 0 angeben)
Somit zu meiner Frage. Wie kann ich die Bildschirmgröße(n) ermitteln um die Position berechnen zu können? Es wäre auch denkbar, dass ich die StartUpPosition von 0 auf einen anderen Wert ändere, dann würde sich die UF einmalig wieder passend ausrichten. Dafür muss ich aber auch wissen, dass sie außerhalb des sichtbaren Bereichs ist.
Danke für eure Hilfe!
Gruß Joni

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Userform Bildschirmausrichtung

19.12.2019 17:23:50

Nepumuk

Hallo Joni,
hier mal ein Beispielcode mit den ein UserForm auf dem Bildschirm angezeigt wird auf dem sich Excel befindet. Daraus kannst du deine Anforderungen ableiten. Wenn du Fragen hast, einfach nachhaken.
Im UserForm:

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 Declare Function GetDC Lib "user32.dll" ( _
    ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" ( _
    ByVal hWnd As Long, _
    ByVal hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32.dll" ( _
    ByVal hdc As Long, _
    ByVal nIndex 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 HWND_DESKTOP As Long = 0&

Private Const LOGPIXELSX As Long = 88&
Private Const LOGPIXELSY As Long = 90&

Private Const MONITOR_DEFAULTTONEAREST As Long = &H2

Private ludtRect As RECT

Public Sub MoveUserform(ByRef probjUserform As Object)
    Dim lngDPI As Long
    lngDPI = GetDPI
    Call EnumDisplayMonitors(ByVal 0&, ByVal 0&, AddressOf Read_Monitor, ByVal 0&)
    With probjUserform
        Call .Move((ludtRect.lngLeft + ludtRect.lngRight) * (72 / lngDPI) / 2 - .Width / 2 _
            , (ludtRect.lngBottom + ludtRect.lngTop) * (72 / lngDPI) / 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

Private Function GetDPI() As Long
    Dim lngDevieCaps As Long
    lngDevieCaps = GetDC(HWND_DESKTOP)
    If lngDevieCaps Then
        GetDPI = (GetDeviceCaps(lngDevieCaps, LOGPIXELSX) + GetDeviceCaps(lngDevieCaps, LOGPIXELSY)) / 2
        Call ReleaseDC(HWND_DESKTOP, lngDevieCaps)
    End If
End Function

Gruß
Nepumuk

AW: Userform Bildschirmausrichtung

19.12.2019 19:13:58

Joni

Hallo Nepumuk,
danke, das hilft schon weiter. Es wird sogar die Taskleiste berücksichtigt :-)
Ich habe den Code jetzt so angepasst, dass er mir immer die Daten von beiden Monitoren liefert. Damit lässt sich arbeiten. Nur aus Interesse, wie müsste der Code angepasst werden wenn es mehr als 2 Monitore sind, sprich für alle vorhandenen? Werden die hochgezählt? Nur falls du Lust hast mir hier auf die Sprünge zu helfen, ist nur theoretisch, da ich sowieso nur 2 Monitore habe.
Danke für deine Hilfe.
Gruß Joni
Hier meine Anpassungen, falls noch ein Denkfehler vorhanden ist, bitte gerne um Aufklärung ;-)

Private ludtRect0 As RECT
Private ludtRect1 As RECT
Private bMonitor0 As Boolean
Private bMonitor1 As Boolean
Public Sub MonitorInfo_Test(ByRef probjUserform As Object)
Dim lngDPI As Long
lngDPI = GetDPI
Call EnumDisplayMonitors(ByVal 0&, ByVal 0&, AddressOf Read_Monitor, ByVal 0&)
Debug.Print ludtRect0.lngLeft
Debug.Print ludtRect0.lngRight
Debug.Print ludtRect0.lngTop
Debug.Print ludtRect0.lngBottom
Debug.Print ludtRect1.lngLeft
Debug.Print ludtRect1.lngRight
Debug.Print ludtRect1.lngTop
Debug.Print ludtRect1.lngBottom
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 And  _
bMonitor0 = False Then
ludtRect0 = udtMonitorInfo.rcWork
bMonitor0 = True
'Read_Monitor = 0
ElseIf bMonitor1 = False Then
ludtRect1 = udtMonitorInfo.rcWork
bMonitor1 = True
'Read_Monitor = 1
End If
If bMonitor0 = False Or bMonitor1 = False Then
Read_Monitor = 1
Else
Read_Monitor = 0
End If
End Function

AW: Userform Bildschirmausrichtung

19.12.2019 20:24:00

Nepumuk

Hallo Joni,
die Monitore werden über den Parameter pvlngMonitor hochgezählt.
Gruß
Nepumuk

AW: Userform Bildschirmausrichtung

19.12.2019 17:35:00

volti

Hallo Joni,
Bildschirmauflösung kann folgendermaßen ermittelt werden:

Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Private Const SM_CXSCREEN = 0

Private Const SM_CYSCREEN = 1

Sub Bildschirmaufloeung()

 Dim X As Long, Y As Long

 X = GetSystemMetrics(SM_CXSCREEN)

 Y = GetSystemMetrics(SM_CYSCREEN)

 MsgBox CStr(X) & "x" & CStr(Y), vbInformation, "Bildschirmauflösung"

End Sub

viele Grüße
Karl-Heinz

AW: Userform Bildschirmausrichtung

19.12.2019 17:46:01

Nepumuk

Hallo Karl-Heinz,
bei zwei Bildschirmen bekommst du damit die Auflösung vom Hauptbildschirm.
Gruß
Nepumuk

AW: Userform Bildschirmausrichtung

19.12.2019 17:56:12

volti

Danke Nepumuk für die Info,
das wusste ich jetzt nicht bzw. die Frage kam bei mir nicht auf, habe auch nur noch einen Bildschirm hier. Wieder was gelernt. :-)
Gruß
Karl-Heinz

Beliebteste Forumthreads (12 Monate)

Forumthread: Userform Bildschirmausrichtung

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread