AW: wieder ein Stück weiter
24.03.2007 10:56:31
Andreas
Hallo Beni!
Das mit der PLZ ist nicht notwendig, wir wollen es nicht zu weit treiben.
Ich danke dir für deine Mühe! Du hast mir sehr geholfen.
Noch 2 Fragen:
Ich möchte das die Userform beim Öffnen der Mappe automatisch öffnet und das diese sich an verschiedene Bildschirmauflösungen anpasst. Für die Bildschirmauflösung habe ich folgenden Artikel (Code) gefunden. Kann man den bei deiner Userform verwenden?
Ach so, doch noch was. Wie wird die Spaltengröße in der unteren Listbox gesteuert, kann man diese anpassen?
Artikel.
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
Ein schönes WE und besten Dank.
mfg Andreas