Option Explicit
 
'für die Bildschirmeinstellung
'Bemerkung: Die Speicherung der Einstellung für die
'Bildschirmgröße erfolgt in der "Bildschirmgroesse.txt"
 
'X = Skaliersfaktor horizontal, Faktor 1 entspricht 1024
'Y = Skalierungsfaktor vertikal, Faktor 1 entspricht 768
Public X As Single
Public Y As Single
 
Public Sub SetDeviceIndependentWindow(FormName As Object, GroesseH As Single, _
  GroesseV As Single)
  ' Diese Prozedur passt die Größe und Anordnung einer Userform
  ' an die jeweilige Auflösung an.
  ' Idee und Grundgerüst von Frank Lubitz
 
  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
 
  X = GroesseH
  Y = GroesseV
 
  'Änderung der Formularposition
  FormName.Height = FormName.Height * Y
  FormName.Width = FormName.Width * X
  'Änderungen der Formularabmessungen
  HeightChange = FormName.Height - OldHeight
  WidthChange = FormName.Width - OldWidth
  'Neupositionierung des Formulars
  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 ComboBox
    ctlControl.FontSize = ctlControl.FontSize * X
        If ctlControl.Style <> 1 Then
            ControlResize3 ctlControl, X, Y
        End If
 
    ElseIf TypeOf ctlControl Is TextBox Then
      ControlResize ctlControl, X, Y
    ElseIf TypeOf ctlControl Is Label Then
      ControlResize2 ctlControl, X, Y
    ElseIf TypeOf ctlControl Is CheckBox Then
      ControlResize2 ctlControl, X, Y
    ElseIf TypeOf ctlControl Is CommandButton Then
      ControlResize2 ctlControl, X, Y
    ElseIf TypeOf ctlControl Is ListBox Then
      ControlResize ctlControl, X, Y
    ElseIf TypeOf ctlControl Is Image Then
      ControlResize3 ctlControl, X, Y
    ElseIf TypeOf ctlControl Is Frame Then
      ControlResize ctlControl, X, Y
    ElseIf TypeOf ctlControl Is OptionButton Then
      ControlResize ctlControl, X, Y
    ElseIf TypeOf ctlControl Is Form Then
      ControlResize ctlControl, X, Y
    ElseIf TypeOf ctlControl Is Shape Then
      ControlResize3 ctlControl, X, Y
    ElseIf TypeOf ctlControl Is Line Then
      ControlResize4 ctlControl, X, Y
    ElseIf TypeOf ctlControl Is PictureBox Then
      ControlResize3 ctlControl, X, Y
    End If
 
Next ctlControl
Exit Sub
ErrorHandler:
  ' try to handle next control
  Resume Next
End Sub
 
Function ControlResize(Control As Control, X, Y)
  With Control
    .FontSize = .FontSize * X
    .Move .Left * X, .Top * Y, .Width * X, .Height * Y
  End With
End Function
 
Function ControlResize2(Control As Control, X, Y)
  With Control
    .Font.Size = .Font.Size * X
    .Move .Left * X, .Top * Y, .Width * X, .Height * Y
  End With
End Function
 
Function ControlResize3(Control As Control, X, Y)
  With Control
    .Move .Left * X, .Top * Y, .Width * X, .Height * Y
  End With
End Function
 
Function ControlResize4(Control As Control, X, Y)
  With Control
    .X1 = .X1 * X
    .Y1 = .Y1 * Y
    .X2 = .X2 * X
    .Y2 = .Y2 * Y
  End With
End Function