AW: Userform fixieren geht das?
31.03.2020 14:07:23
Nepumuk
Hallo Holly,
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 Const LOGPIXELS_Y As Long = 90&
Private Sub UserForm_Layout()
Left = GetSystemMetrics(SM_CXSCREEN) * GetResolution(LOGPIXELS_X) / 2 - Width / 2
Top = GetSystemMetrics(SM_CYSCREEN) * GetResolution(LOGPIXELS_Y) / 2 - Height / 2
End Sub
Private Function GetResolution(ByVal pvlngLogPixel As Long) As Single
Dim lngptrhWndDesk As LongPtr, lngptrhDCDesk As LongPtr
Dim lnglogPixel As Long
lngptrhWndDesk = GetDesktopWindow()
lngptrhDCDesk = GetDC(lngptrhWndDesk)
lnglogPixel = GetDeviceCaps(lngptrhDCDesk, pvlngLogPixel)
Call ReleaseDC(lngptrhWndDesk, lngptrhDCDesk)
GetResolution = 72 / lnglogPixel
End Function
Gruß
Nepumuk