AW: Userform Zomen oder Bildschirmgrösse
19.01.2020 16:58:05
Nepumuk
Hallo Johannes,
teste mal:
Option Explicit
Private Declare PtrSafe Function GetSystemMetrics Lib "user32.dll" ( _
ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetDesktopWindow Lib "user32.dll" () As LongPtr
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 Const SM_CXSCREEN As Long = 0
Private Const SM_CYSCREEN As Long = 1
Private Const LOGPIXELS_X As Long = 88&
Private Sub UserForm_Activate()
Dim sngWidth As Single, sngHeight As Single
Dim sngScreenResolution As Single
sngScreenResolution = GetResolution
sngWidth = Width
sngHeight = Height
Left = 0
Top = 0
Width = GetSystemMetrics(SM_CXSCREEN) * sngScreenResolution
Height = GetSystemMetrics(SM_CYSCREEN) * sngScreenResolution
Zoom = Fix(WorksheetFunction.Min(Width / sngWidth, Height / sngHeight) * 100)
End Sub
Private Function GetResolution() As Single
Dim lngptrhWndDesk As LongPtr, lngptrhDCDesk As LongPtr
Dim lnglogPix As Long
lngptrhWndDesk = GetDesktopWindow()
lngptrhDCDesk = GetDC(lngptrhWndDesk)
lnglogPix = GetDeviceCaps(lngptrhDCDesk, LOGPIXELS_X)
Call ReleaseDC(lngptrhWndDesk, lngptrhDCDesk)
GetResolution = 72 / lnglogPix
End Function
Gruß
Nepumuk