UserForm Bildschirmskalierung anpassen

Guten Tag zusammen,

Ich erstelle zurzeit ein Expertensystem für die Auswahl von geeigneten Packmitteln für bestimmte Gefahrenstoffe. Damit die Stammdaten des Systems einfach gepflegt werden können erfolgt die Dateneingabe in Excel - die Daten werden anschließend automatisiert exportiert. Für den Benutzer werden Eingabemasken als EXCEL-User-Form zur Verfügung gestellt. Die Darstellung des User-Forms soll nun auf jeglichen Rechnern, unabhängig von Bildschirmauflösung und Skalierung identisch dargestellt werden.

Problem: Ändert man in den Windows-Anzeigeeinstellungen (siehe "Screenshot1_Anzeigeeinstellungen") die Skalierung (z.B. von 100% auf 125%), wird das USER-Form anschließend völlig verzerrt dargestellt (siehe "Screenshot2_verzerrte_Darstellung"). Gibt es eine Möglichkeit bei Start der Excel-Datei, die Skalierung abzufragen und das User-Form automatisch anzupassen, sodass es immer korrekt dargestellt wird (siehe "Screenshot3_korrekte_Darstellung")?

Eine ähnliche Lösung gibt es für die Bildschirmauflösung (siehe: https://www.excel-inside.de/beispiele_vba/vba-userforms/318-userform-anhand-der-bildschirmaufloesung-zoomen), jedoch nicht für den Skalierungsfaktor. Ich bin über jeden Lösungsvorschlag und Ideen dankbar!

Screenshots: https://www.herber.de/bbs/user/158753.zip

Vielen Dank und beste Grüße,

Max

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Max,

teste mal (im Modul des Userforms):

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_Activate()

    Dim sngWidth As Single, sngHeight As Single

    sngWidth = Width
    sngHeight = Height

    Left = 0
    Top = 0

    Width = GetSystemMetrics(SM_CXSCREEN) * GetResolution(LOGPIXELS_X)
    Height = GetSystemMetrics(SM_CYSCREEN) * GetResolution(LOGPIXELS_Y)

    Zoom = Fix(Application.Min(Width / sngWidth, Height / sngHeight) * 100)

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

Beliebteste Forumthreads (12 Monate)

UserForm Bildschirmskalierung anpassen

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

UserForm Bildschirmskalierung anpassen

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread