Hallo Reinhard,
ich überprüfe zunächst, ob der Bildschirm auf 800x600 eingestellt ist, wenn ja wird die Sub ausgeführt, mit der ich derzeit die Größe anpasse. Habe ich im Netz gefunden, gefällt mir aber nicht wirklich. Wäre im Notfall allerdings OK.
Hier ist der Code, den ich nutze:
Sub Userform\_Activate()
Dim X As String
X = ScreenResolution()
If X = "800x600" Then
SetDeviceIndependentWindow Me 'aktuelle Funktion, um Bildschirmauflösung anzupassen
End If
End Sub
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
Private Const SM\_CXSCREEN = 0
Private Const SM\_CYSCREEN = 1
Private Declare Function GetSystemMetrics Lib "user32" \_
(ByVal nIndex As Long) As Long
Public Function ScreenResolution()
ScreenResolution = GetSystemMetrics(SM\_CXSCREEN) & \_
"x" & GetSystemMetrics(SM\_CYSCREEN)
End Function
Falls es keine bessere Lösung gibt, wäre die sonst OK, allerdings hätte ich dann gleich noch eine Frage:
Ich möchte für eine Listbox in einer UserForm die Funktionen listbox1_MouseMove und listbox1_Click benutzen. Allerdings bemotzt der das, weil er scheinbar nicht damit leben kann, beide Funktionen gleichzeitig zu haben. Aus Java kenne ich es so, dass ich eben verschiedene Events für ein Objekt nutzen kann und hier sind es ja auch zwei unterschiedliche Ereignisse.
Gibt es dafür vielleicht auch ne Alternative, bzw. was mache ich falsch?
Vielen Dank schon mal,
Elisabeth
