ich habe folgenden Code zur Bildschirmauflösung-Anpassung benutzt:
Option Explicit
Public Const X_RESOLUTION = 1400
Public Const Y_RESOLUTION = 1050
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Public
Sub SetDeviceIndependentWindow(FormName As Object)
Dim gWidth As Integer, gHeight As Integer
gWidth = GetSystemMetrics(SM_CXSCREEN)
gHeight = GetSystemMetrics(SM_CYSCREEN)
Dim XFactor As Single
Dim YFactor As Single
Dim X As Integer
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
On Error GoTo ErrorHandler
XFactor = gWidth / X_RESOLUTION
YFactor = gHeight / Y_RESOLUTION
If XFactor = 1 And YFactor = 1 Then Exit Sub
OldHeight = FormName.Height
OldWidth = FormName.Width
FormName.Height = FormName.Height * YFactor
FormName.Width = FormName.Width * XFactor
HeightChange = FormName.Height - OldHeight
WidthChange = FormName.Width - OldWidth
FormName.Left = FormName.Left - WidthChange / 2
FormName.Top = FormName.Top - HeightChange / 2
For Each ctlControl In FormName.Controls
Debug.Print ctlControl.Name
If TypeOf ctlControl Is ComboBox Then
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:
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
Funktioniert einwandfrei, kann ich echt empfehlen!!!
ABER: ich habe in meiner UF auch zwei ListBoxen die so gefüllt werden:
Dim c As Range, lz As Long, z As Long, arr(), i As Long, bolFound As Boolean
Set c = List5.Cells(Rows.Count, 15)
lz = c.Row: If IsEmpty(c) Then lz = c.End(-4162).Row
For z = 2 To lz
If List5.Cells(z, 15)
bolFound = True
i = i + 1
ReDim Preserve arr(3, i)
arr(1, i) = List5.Cells(z, 1)
arr(2, i) = List5.Cells(z, 15)
arr(3, i) = List5.Cells(z, 15)
End If
Next
If bolFound Then
frm_START.ListBox1.Column = arr
End If
Dim b As Range, ky As Long, y As Long, ass(), h As Long, tolFound As Boolean
Set b = List5.Cells(Rows.Count, 15)
ky = b.Row: If IsEmpty(b) Then ky = b.End(-4162).Row
For y = 2 To ky
If List5.Cells(y, 18)
tolFound = True
h = h + 1
ReDim Preserve ass(3, h)
ass(1, h) = List5.Cells(y, 1)
ass(2, h) = List5.Cells(y, 18)
ass(3, h) = List5.Cells(y, 18)
End If
Next
If tolFound Then
frm_START.ListBox2.Column = ass
End If
Nun mein Problem; Die ListBox wird zwar verkleinert bei veränderter Auflösung nur bleibt der Font gleichgross und die Colum-Breite der Box ( sind ja 3 ) ändert sich nicht, hat jemand eine Ahnung wieso?
Bitte helfen...
Grüsse
Drazen