Beim Erstellen einer Userform wird diese normalerweise so gestaltet, dass sie auf dem Bildschirm des Erstellers optimal aussieht.
Sobald diese Userform aber mit einer anderen Bildschirmauflösung betrachtet wird, z.B. auf anderen Arbeitsplätzen, kann es wünschenswert sein, diese Userform in der Größe zu ändern. Leider besitzen die Userforms unter VBA, im Gegensatz zu denen unter VB, keine direkte Resize-Möglichkeit; und selbst wenn, dann würden die Controls auf der Userform nicht automatisch mitangepasst (was sie aber auch unter VB nicht machen).
Um eine Userform auflösungsunabhängig zu gestalten, kann nachfolgende Prozedur SetDeviceIndependentWindow verwendet werden. Mit dieser Prozedur wird die aktuelle Bildschirm-auflösung mit der verglichen, unter der die Userform erstellt wurde. Diese Angaben werden dabei als Konstante angegeben.
Hat sich die Auflösung geändert, werden die Userform und alle Standard-Controls in der Größe und Position an die neue Auflösung angepasst.
Dazu genügt es, aus der Userform diese Prozedur aufzurufen und die zu ändernde Userform als Parameter mitanzugeben.
In der Prozedur werden dann alle Controls der Form durchlaufen (If TypeOf ... Is ... Then) und an
die aktuelle Bildschirmauflösung angepasst. Auch wird - sofern möglich - die Schriftgröße neuberechnet und mitgeändert.
Falls Controls verwendet werden,
die nicht zu den Standard-Controls der MSForms gehören, können diese in die Liste der Control-Typen hinzugefügt werden. Ansonsten wird versucht, diese in der Größe und Position zu ändern; sollten entsprechende Eigenschaften nicht geändert werden können oder existieren, müssen diese Fehler noch abgefangen werden.
Der Aufruf der Prozedur kann dann in der "Activate"-Methode der Userform erfolgen.
Option Explicit
' Bildschirmauflösung, unter der die Userform erstellt wurde
Public Const X_RESOLUTION = 1280 '640
Public Const Y_RESOLUTION = 1024 '480
Public Sub SetDeviceIndependentWindow(FormName As Object)
' Diese Prozedur passt die Größe und Anordnung einer Userform
' an die jeweilige Auflösung an.
' Idee und Grundgerüst von Frank Lubitz
'
' Im Prozeduraufruf muss die zu ändernde Userform angegeben werden
Dim XFactor As Single ' Horizontal resize ratio
Dim YFactor As Single ' Vertical resize ratio
Dim X As Integer ' For/Next loop variable
Dim xPixels As Single
Dim yPixels As Single
Dim HeightChange As Long
Dim WidthChange As Long
Dim OldHeight As Long
Dim OldWidth As Long
Dim ctlControl As Control
'
' Fehlermeldungen abfangen
On Error GoTo ErrorHandler
' Vergrößerungs-/Verkleinerungsfaktor der aktuellen Auflösung
' in Bezug auf die ursprünglche Auflösung
XFactor = System.HorizontalResolution / X_RESOLUTION
YFactor = System.VerticalResolution / Y_RESOLUTION
' Keine Neuanordung bei identischer Auflösung
If XFactor = 1 And YFactor = 1 Then Exit Sub
' Alte Einstellungen sichern
OldHeight = FormName.Height
OldWidth = FormName.Width
' Neue Abmessung der Userform berechnen
FormName.Height = FormName.Height * YFactor
FormName.Width = FormName.Width * XFactor
' Änderungen der Abmessungen
HeightChange = FormName.Height - OldHeight
WidthChange = FormName.Width - OldWidth
' Userform neu positionieren
FormName.Left = FormName.Left - WidthChange / 2
FormName.Top = FormName.Top - HeightChange / 2
' Alle Controls durchlaufen und ändern
For Each ctlControl In FormName.Controls
Debug.Print ctlControl.Name
If TypeOf ctlControl Is ComboBox Then
' If Not a Simple Combo box
ctlControl.FontSize = ctlControl.FontSize * XFactor
If ctlControl.Style <> 1 Then
ControlResize3 ctlControl, XFactor, YFactor
End If
ElseIf TypeOf ctlControl Is TextBox Then
ControlResize ctlControl, XFactor, YFactor
ElseIf TypeOf ctlControl Is Label Then
ControlResize ctlControl, XFactor, YFactor
ElseIf TypeOf ctlControl Is CheckBox Then
ControlResize2 ctlControl, XFactor, YFactor
ElseIf TypeOf ctlControl Is CommandButton Then
ControlResize2 ctlControl, XFactor, YFactor
ElseIf TypeOf ctlControl Is ListBox Then
ControlResize ctlControl, XFactor, YFactor
ElseIf TypeOf ctlControl Is Image Then
ControlResize3 ctlControl, XFactor, YFactor
ElseIf TypeOf ctlControl Is OptionButton Then
ControlResize2 ctlControl, XFactor, YFactor
ElseIf TypeOf ctlControl Is MultiPage Then
ControlResize2 ctlControl, XFactor, YFactor
ElseIf TypeOf ctlControl Is ToggleButton Then
ControlResize2 ctlControl, XFactor, YFactor
ElseIf TypeOf ctlControl Is SpinButton Then
ControlResize3 ctlControl, XFactor, YFactor
ElseIf TypeOf ctlControl Is ScrollBar Then
ControlResize3 ctlControl, XFactor, YFactor
Else
ControlResize2 ctlControl, XFactor, YFactor
End If
Next ctlControl
Exit Sub
ErrorHandler:
' try to handle next control
Resume Next
End Sub
Function ControlResize(Control As Control, XFactor, YFactor)
With Control
.FontSize = .FontSize * XFactor
.Move .Left * XFactor, .Top * YFactor, .Width * XFactor, .Height * YFactor
End With
End Function
Function ControlResize2(Control As Control, XFactor, YFactor)
With Control
.Font.Size = .Font.Size * XFactor
.Move .Left * XFactor, .Top * YFactor, .Width * XFactor, .Height * YFactor
End With
End Function
Function ControlResize3(Control As Control, XFactor, YFactor)
With Control
.Move .Left * XFactor, .Top * YFactor, .Width * XFactor, .Height * YFactor
End With
End Function
Dank an Frank Lubitz für den Quellcode.
Hinweis für Excel-Anwender
Wenn Ihr obigen Code in Excel verwenden möchtet bekommt Ihr eine Fehlermeldung, da unter Excel das
System-Objekt nicht bekannt ist. Somit bekommt Ihr auf diesem Weg auch nicht die Bildschirmauflösung.
Abhilfe verschafft in diesem Fall das API GetSystemMetrics32:
' Bildschirmauflösung, unter der die Userform erstellt wurde
Declare Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1
und mit folgenden Änderungen in der Prozedur SetDeviceIndependentWindow(FormName As Object):
' Vergrößerungs-/Verkleinerungsfaktor der aktuellen Auflösung
' in Bezug auf die ursprünglche Auflösung
' Excel: mittels API
XFactor = GetSystemMetrics32(SM_CXSCREEN) / X_RESOLUTION
YFactor = GetSystemMetrics32(SM_CYSCREEN) / Y_RESOLUTION
' Word: System-Objekt
' XFactor = System.HorizontalResolution / X_RESOLUTION
' YFactor = System.VerticalResolution / Y_RESOLUTION
funktioniert die UserForm-Anpassung auch unter Excel.
|