Eine Userform an die jeweilige Bildschirmauflösung anpassen


			Eine Userform an die jeweilige Bildschirmauflösung anpassen

Microsoft Word-Programmierung - Das Handbuch 4. Auflage für Word 2007 bis 2013!

ersch. 02/2014

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.

Sub Userform_Activate()  
  SetDeviceIndependentWindow Me
End Sub

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.

	Besucher: 0 online \| 0 heute \| 0 diesen Monat \| 2219119 insgesamt \| Seitenaufrufe: 125		Letzte Änderung: 22.02.2009		© 2001-18 Christian Freßdorf
	In vielen Firmen beginnt das Sparen - beim freundlichen Wort. Hans-Horst Skupy				powered by phpCMS and PAX