AW: Userform auf Bildschirm 2 öffnen ?
13.11.2021 14:47:16
Nepumuk
Hallo,
im Modul deine UserForms:
Private Sub UserForm_Initialize()
Call MoveUserform(Me)
End Sub
In einem Standardmodul (Menüleiste des VBA-Editors - Einfügen - Modul):
Option Explicit
Private Declare PtrSafe Function EnumDisplayMonitors Lib "user32.dll" ( _
ByVal hdc As LongPtr, _
ByRef lprcClip As LongPtr, _
ByVal lpfnEnum As LongPtr, _
ByVal dwData As Long) As Long
Private Declare PtrSafe Function GetMonitorInfoA Lib "user32.dll" ( _
ByVal hMonitor As LongPtr, _
ByRef lpmi As MONITORINFO) As Long
Private Declare PtrSafe Function GetDC Lib "user32.dll" ( _
ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function ReleaseDC Lib "user32.dll" ( _
ByVal hwnd As LongPtr, _
ByVal hdc As LongPtr) As Long
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32.dll" ( _
ByVal hdc As LongPtr, _
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 LongPtr = 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 sngDPI As Single
sngDPI = GetDPI
Call EnumDisplayMonitors(ByVal 0, ByVal 0, AddressOf Read_Monitor, ByVal 0&)
With probjUserform
Call .Move((ludtRect.lngLeft + ludtRect.lngRight) * sngDPI / 2 - .Width / 2 _
, (ludtRect.lngBottom + ludtRect.lngTop) * sngDPI / 2 - .Height / 2)
End With
End Sub
Private Function Read_Monitor( _
ByVal pvlngptrMonitor As LongPtr, _
ByVal pvlngptrHdcMonitor As LongPtr, _
ByRef prudtlprcMonitor As RECT, _
ByVal pvlngdwData As Long) As Long
Dim udtMonitorInfo As MONITORINFO
udtMonitorInfo.cbSize = Len(udtMonitorInfo)
Call GetMonitorInfoA(pvlngptrMonitor, udtMonitorInfo)
If udtMonitorInfo.dwFlags = 0 Then
ludtRect = udtMonitorInfo.rcWork
Read_Monitor = 0
Else
Read_Monitor = 1
End If
End Function
Private Function GetDPI() As Single
Dim lngptrDevieCaps As LongPtr
lngptrDevieCaps = GetDC(HWND_DESKTOP)
If lngptrDevieCaps 0 Then
GetDPI = 72 / ((GetDeviceCaps(lngptrDevieCaps, LOGPIXELSX) + GetDeviceCaps(lngptrDevieCaps, LOGPIXELSY)) / 2)
Call ReleaseDC(HWND_DESKTOP, lngptrDevieCaps)
End If
End Function
Gruß
Nepumuk