AW: Bildschirmauflösung
17.11.2018 12:57:57
Bernd
Hi Sigrid,
so habe ich das Problem gelöst Auflösung von PC zu Laptop.
Option Explicit
Public lngIdR1 As Long
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 GetMonitorInfo Lib "user32.dll" Alias "GetMonitorInfoA" ( _
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 FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) 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 Const GC_CLASSNAMEMSEXCEL = "XLMAIN"
Private ludtRect As RECT
Public Sub Set_Userform_Size(ByRef probjUserform As Object)
Dim sngZoom As Single
'Die Bildschirmabmessungen auslesen auf dem Excel liegt
Call EnumDisplayMonitors(ByVal 0&, ByVal 0&, AddressOf Read_Monitor, ByVal 0&)
With probjUserform
'Userform auf benutzerdefinierte Bildschirmposition anzeigen
.StartUpPosition = 0
'Zoomfaktor der Steuerelemente initialisieren
sngZoom = 100
'Verkleinern des Userform in 2% Schritten
Do While .Width > Abs(ludtRect.lngLeft - ludtRect.lngRight) * 0.75 Or _
.Height > ludtRect.lngBottom * 0.75
sngZoom = sngZoom * 0.98
.Width = .Width * 0.98
.Height = .Height * 0.98
Loop
'Zoomfaktor fuer Steuerelemente setzen
.Zoom = Fix(sngZoom)
'Userform in die Mitte der freien Arbeitsflaeche schieben
.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
Dim lngHwnd As Long
'Das Windows-Handle von Excel lesen
If Val(Application.Version)
Den Code habe ich vor einigen Jahren mal im Netz gefunden.
In das UserForm_Initialize Ereigniss setzt du nachfolgenden Satz ein...
Call Set_Userform_Size(Me)
Rückmeldung wäre schön.
Office Version 2016 Pro 32bit - Windows10 Pro 64 bit
"Wenn du jemanden ohne Lächeln triffst, schenke ihm dein's!"