Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
536to540
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
536to540
536to540
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

ListBox (Text) wird bei Resize nich verkleinert

ListBox (Text) wird bei Resize nich verkleinert
20.12.2004 23:46:49
Drazen
Hallo,
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

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: ListBox (Text) wird bei Resize nich verkleiner
21.12.2004 00:11:50
Josef
Hallo Drazen!
Dafür wahr nichts vorgesehen!
Probier mal.
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
ControlResize4 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

Function ControlResize4(Control As Control, XFactor, YFactor)
Dim str As String
Dim arr As Variant
Dim n As Integer
With Control
.Font.Size = .Font.Size * XFactor
.Move .Left * XFactor, .Top * YFactor, .Width * XFactor, .Height * YFactor
If .ColumnCount > 1 Then
str = .ColumnWidths
arr = Split(str, ";")
str = ""
For n = 0 To UBound(arr)
str = str & Val(arr(n)) * XFactor & ";"
Next
str = Left(str, Len(str) - 1)
.ColumnWidths = str
End If
End With
End Function

Gruß Sepp
Anzeige
möchte ein "h" zurückkaufen! o.T.
21.12.2004 00:12:41
Josef
Gruß Sepp
AW: möchte ein "h" zurückkaufen! o.T.
21.12.2004 00:38:18
Drazen
Hi Sepp,
"H", behalt ich mal, vieleicht brauch ich es ja noch irgendwo, Code macht Sinn funktioniert aber trotzdem immer noch nicht, kann es sein, dass ich die ColumWidhts irgendwie anpassen muss,Colums nehmen muss weil ich ja nur zwei anzeigen will, Daten aus der Spalte A und J / A und M.
Gruss
Drazen
AW: möchte ein "h" zurückkaufen! o.T.
21.12.2004 01:12:17
Josef
Hallo Drazen!
Interesantes Phänomen!
"TypeOf" erkennt die ListBox nicht!
Versuchs mal so:
(nur diese Sub ersetzen!)

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 TypeName(ctlControl) = "ComboBox" Then
ControlResize4 ctlControl, XFactor, YFactor
ElseIf TypeName(ctlControl) = "TextBox" Then
ControlResize ctlControl, XFactor, YFactor
ElseIf TypeName(ctlControl) = "Label" Then
ControlResize ctlControl, XFactor, YFactor
ElseIf TypeName(ctlControl) = "CheckBox" Then
ControlResize2 ctlControl, XFactor, YFactor
ElseIf TypeName(ctlControl) = "CommandButton" Then
ControlResize2 ctlControl, XFactor, YFactor
ElseIf TypeName(ctlControl) = "ListBox" Then
ControlResize4 ctlControl, XFactor, YFactor
ElseIf TypeName(ctlControl) = "Image" Then
ControlResize3 ctlControl, XFactor, YFactor
ElseIf TypeName(ctlControl) = "OptionButton" Then
ControlResize2 ctlControl, XFactor, YFactor
ElseIf TypeName(ctlControl) = "MultiPage" Then
ControlResize2 ctlControl, XFactor, YFactor
ElseIf TypeName(ctlControl) = "ToggleButton" Then
ControlResize2 ctlControl, XFactor, YFactor
ElseIf TypeName(ctlControl) = "SpinButton" Then
ControlResize3 ctlControl, XFactor, YFactor
ElseIf TypeName(ctlControl) = "ScrollBar" Then
ControlResize3 ctlControl, XFactor, YFactor
Else
ControlResize2 ctlControl, XFactor, YFactor
End If
Next ctlControl
Exit Sub
ErrorHandler:
Resume Next
End Sub

Gruß Sepp
Anzeige
Und wieder mal ein Sieg für den Profi!!!
21.12.2004 01:28:04
Drazen
Hi Sepp,
was soll ich sagen... wer's kann der kann's halt. Einfach cool. Vielen Dank.
Ich soll Dir übrigens nette Grüsse von der Küste Kroatiens bestellen, wie schon gesagt dort sitzt ein weiterer Profi der mir viel bei meinem Programieren hilft, und er plant eine Excel-Schulung verbunden mit Urlaub in Kroatien, falls Du interesse an so etwas haben solltest schreib mir ne direkte mail an drazen_sokac@t-online.de, ich werde versuchen euch zu verbinden, da kommt bestimmt was gutes bei raus, er bewundert Deine Arbeit sehr, Herbert war auch schon vor zwei Jahren beim Zeljko...
Grüsse
Drazen
Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige