2
www.ChF-Online.de  

Eine Userform an die jeweilige Bildschirmauflösung anpassen

   Neuigkeiten
   API-Aufrufe in VBA
   VBA2HTML
   Word
   Word-VBA
 Verschiedenes
 Feld-Arbeiten
aktiv aktiv Form-Sachen
aktiv  Auflösungs-Erscheinung
 Fenster-Splitter
 Fortschrittliches
 Hyperlinks in Userformen
 Kontextmenü erstellen
 Pflichtfeldprüfung
 Vorgabewerte ändern
 Menü-/Symbolleisten
 VBA und Lotus Notes
 VBA und Mail
 Inside VBAIDE
 Von Word nach Outlook
 Fix-und-Fertiges/Projekte
   Word2007 (RibbonX)
   Word2010 (RibbonX)
   Outlook-VBA
   Links zu VB(A)
   DocToHelp
   Netport Express XL
   Astronomie
   Gästebuch
   Volltextsuche
   Sitemap
   Buch:Word-Programmierung
   Impressum & Kontakt
   Datenschutzerklärung
Getestet unter Word2000Getestet unter WordXPGetestet unter Word2003Getestet unter Word2007Getestet unter Excel2003Getestet unter Excel2007  
Beispiel anzeigen
Makro/Datei speichern
Print

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.

Code markieren
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:

Code markieren
' 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):

Code markieren
  ' 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: 1 online  |  42 heute  |  1381 diesen Monat  |  683126 insgesamt | Seitenaufrufe: 110   Letzte Änderung: 22.02.2009 © 2001-18 Christian Freßdorf
  Sage nicht alles, was Du weißt, aber wisse immer, was Du sagst.
Matthias Claudius
 powered by phpCMS and PAX