AW: Userforms platzieren bei 2 Monitoren
08.06.2015 12:34:06
Nepumuk
Hallo,
dann teste mal folgendes.
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 = &H2
Private ludtRect As RECT
Public Sub MoveUserform(ByRef probjUserform As Object)
Dim udtDeleteRect As RECT
Call EnumDisplayMonitors(ByVal 0&, ByVal 0&, AddressOf Read_Monitor, ByVal 0&)
With probjUserform
Call .Move((ludtRect.lngLeft - (ludtRect.lngRight) * -1) * 0.75 / 2 - .Width / 2 _
, ludtRect.lngBottom * 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
Im Modul des UserForms:
Private Sub UserForm_Initialize()
Call MoveUserform(Me)
End Sub
Gruß
Nepumuk