Userform Bildschirmauflösung Probleme

Private Sub UserForm_Initialize() ' Bildschirmauflösung, unter der die Userform erstellt wurde ' Breite 1152; 1280; 640 ' Höhe 864; 1024; 480 ' 1152 ist die Breite des Bildschirmes bei Erstellung ' Code Zeile von L.Vira Anpassung der Formel mit Wertermttlung von Hajo.Ziplies@web.de Me.Zoom = GetSystemMetrics(SM_CXSCREEN) / 1152 * 100 End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Private Declare PtrSafe Function GetSystemMetrics Lib "user32.dll" ( _ ByVal nIndex As Long) As Long Private Const SM_CXSCREEN As Long = 0 Private Const SM_CYSCREEN As Long = 1 Private Sub UserForm_Activate() Dim sngWidth As Single, sngHeight As Single sngWidth = Width sngHeight = Height Left = 0 Top = 0 Width = GetSystemMetrics(SM_CXSCREEN) * 0.75 Height = GetSystemMetrics(SM_CYSCREEN) * 0.75 Zoom = Fix(WorksheetFunction.Min(Width / sngWidth, Height / sngHeight) * 100) End Sub Gruß Nepumuk

Option Explicit Private Declare PtrSafe Function GetSystemMetrics Lib "user32.dll" ( _ ByVal nIndex As Long) As Long Private Const SM_CXSCREEN As Long = 0 Private Const SM_CYSCREEN As Long = 1 Public Sub Test() Application.WindowState = xlMaximized Debug.Print Application.Width & " / " & Application.Height Debug.Print GetSystemMetrics(SM_CXSCREEN) * 0.75 & " / " & GetSystemMetrics(SM_CYSCREEN) * 0.75 End Sub Was wird im Direktfenster ausgegeben? Gruß Nepumuk

Private Sub UserForm_Initialize() StartUpPosition = 0 Top = 0 Left = 0 Width = Application.Width Height = Application.Height End Sub Das stimmt zwar auch nicht ganz, ist aber besser als vorher. Gruß Nepumuk

Hallo Nepumuk,
mit folgender Einstellung im Code der Userform funktioniert die Userform einwandfrei.

Private Sub userform_activate()
StartUpPosition = 0
Top = 5
Left = 5
Width = Application.Width - 20
Height = Application.Height - 20
End Sub

Daher habe ich den Vorschlag von Planlos nicht mehr weiterverfolgt.
Bezüglich dem Inhalt der Userform sprich Steuerelemente ist die Zoom-Eigenschaft zu ändern ungünstig,
weil dadurch Verzerrungen entstehen.
Ich habe mir folgendes Modul erstellt, für alle Eigenschaften Left, Top, Width, Height je Steuerelement:
Option Explicit
'** API-Funktion zum Auslesen der Bildschirmauflösung
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1
#If Win64 Then
Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As LongPtr) As Long
#Else
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
#End If
Sub UserForm_Test()
Dim CmdW_Basis As Integer 'Breite von Commandbutton
Dim CmdH_Basis As Integer 'Höhe von Commandbutton
Dim WBasis As Integer 'Basiswert der horizontalen Bildschirmauflösung
Dim HBasis As Integer 'Basiswert der vertikalen Bildschirmauflösung
Dim WWert As Integer 'ausgelesener horizontale Bildschirmauflösung
Dim HWert As Integer 'ausgelesene vertikale Bildschirmauflösung
Dim WWB As Integer 'Verhältnis zwischen horizontaler Bildschirmauflösung und Basisbildschirmauflösung
Dim HWB As Integer 'Verhältnis zwischen vertikaler Bildschirmauflösung und Basisbildschirmauflösung
'Basiswert von Commandbutton
CmdW_Basis = UserForm1_Datenmaske2.CommandButton8.Width
CmdH_Basis = UserForm1_Datenmaske2.CommandButton8.Height
'Basiswert von Bildschirmauslösung
WBasis = 1600
HBasis = 900
'Ausgelesene horizontale und vertikale Bildschirmauflösung
WWert = GetSystemMetrics(SM_CXSCREEN)
HWert = GetSystemMetrics(SM_CYSCREEN)
'Test ist Verhältnis zwischen horizontaler ausgelesener und Basis Bildschirmauflösung
WWB = WWert / WBasis
'Test ist Verhältnis zwischen vertikaler ausgelesener und Basis Bildschirmauflösung
HWB = HWert / HBasis
'alle Width 35 Label, 31 Textboxes, 9 Combiboxes, 8 Commandbutton,1 Listbox, 2 Register
UserForm1_Datenmaske2.Label723.Width = UserForm1_Datenmaske2.Label723.Width * WWert / WBasis
Das funktioniert von Bildschirmauflösung 1600x900 abwärts nicht jedoch aufwärts. Es geht um die Auflösung 1920x1080 dort werden die Elemente jetzt zu gross. Problem ist ausserdem, dass die Bildschirme bezüglich Anzeige der Schriftgrössen unterschiedlich gesteuert sind.
Andere Programme sind hiervon abhängig. Gibt es hierfür eine Lösung?
Danke Gruss Peter

dim lRet as long dim lx as long dim ly as long lx = 96 ly = 96 lret = CreateIC("DISPLAY", vbNullString, vbNullString, vbNullString) if lret <> 0 then lx = GetDeviceCaps(lret, 88) ly = GetDeviceCaps(lret, 90) DeleteDC lRet endif

Private Declare Function CreateIC Lib "gdi32" Alias "CreateICA" _ ( _ ByVal lpDriverName As String, _ ByVal lpDeviceName As String, _ ByVal lpOutput As String, lpInitData As Any _ ) As Long Private Declare Function DeleteDC Lib "gdi32" _ ( _ ByVal hDC As Long _ ) As Long Private Declare Function GetSystemMetrics Lib "user32" _ ( _ ByVal nIndex As Long _ ) As Long Private Declare Function GetDeviceCaps Lib "GDI32.DLL" _ ( _ ByVal hDC As Long, _ ByVal nIndex As Long _ ) As Long Private Const LOGPIXELSX = 88 Private Const LOGPIXELSY = 90 Private Const SM_CXSCREEN = 0 Private Const SM_CYSCREEN = 1 Private Sub UserForm_Activate() Dim lxDot As Long Dim lyDot As Long Dim lIC As Long lxDot = 96 lyDot = 96 lIC = CreateIC("DISPLAY", vbNullString, vbNullString, vbNullString) If lIC <> 0 Then lxDot = GetDeviceCaps(lIC, LOGPIXELSX) lyDot = GetDeviceCaps(lIC, LOGPIXELSY) DeleteDC lIC End If Me.Left = 0 Me.Top = 0 Me.Width = GetSystemMetrics(SM_CXSCREEN) * (72 / lxDot) Me.Height = GetSystemMetrics(SM_CYSCREEN) * (72 / lyDot) End Sub

Hallo Planlos,
Danke für Deine Info. Ich habe jetzt eine Datei erstellt. Folgendes Problem:
Ich habe eine Userform die sich an die Bildschirmauflösung anpasst. Nur der Inhalt der UF (Steuerelemente)passen sich nicht an. Auf den PC ist ein Programm installiert, welches je nach Monitor über System - Einstellungen - Bildschirm - Grösse von Text ect. auf 100, 125 oder 150 % eingestellt sind.
Z. B. der eine PC hat bei 100% 2400x1350, bei 125 % 1920x1080 und bei 150 % 1600x900.
der andere PC hat bei 100% 2880x1620, bei 125 % 2304x1296 und bei 150 % 1920x1080.
Diese Programm benötigt Einstellung 1920x1080.
Ich habe nun meine UF bei der Auflösung 2400x1350 erstellt. Beim ersten PC muss ich nun Zoom 80 % und beim anderen PC Zoom 100 % einstellen. Alle PC sind auf 1920x1080 eingestellt haben aber je nach Monitor eine andere Zoomeinstellung. Wenn ich per API oder ähnlichem abfragen könnte, welche höchste Bildschirmauflösung vorhanden ist und welche Grösse von Text ect. eingestellt ist könnte ich dies automatisch angleichen. Ich füge eine Musterdatei bei. Hier ist der Code in der Userform zutreffend.

Die Datei https://www.herber.de/bbs/user/102310.xlsm wurde aus Datenschutzgründen gelöscht

Vielleicht weisst Du eine Lösung.
Gruss Peter

Beliebteste Forumthreads (12 Monate)

Userform Bildschirmauflösung Probleme

38
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

1 Forumthread zu ähnlichem Thema

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Userform Bildschirmauflösung Probleme

38 Beiträge zum Forumthread Beiträge zu diesem Forumthread

1 Forumthread zu ähnlichem Thema

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

38
Beiträge zum Forumthread

Beiträge zu diesem Forumthread