Office: ListBox: automatische Spaltenbreite

Osebi · 23. Februar 2015

Guten Tag miteinander

Dank eurer Hilfe funktionieren sämtliche Codes in meiner Userform. Nun hätte ich noch ein Anliegen - kein Muss, aber ein kleines Nice to Have.

Wie kann ich im untenstehenden Code einen Befehl einfügen, damit sich die Spalten der Listbox automatisch/dynamisch in der Breite anpassen (nicht jeder Name, Vorname etc. braucht gleich viel Platz)?

Code:

Private Sub cmdSuchen_Click()
Dim s As String
Dim Found As Range
Dim FirstAddress As String
Dim ZeileMAx As Long
Dim Vardat As Variant

On Error Resume Next
i = 0
s = Trim(TextBoxSuchen.text)
If s = "" Then Exit Sub
ListBoxSuchen.Clear
With ActiveSheet
Set Found = .Cells.Find(What:=s, LookAt:=xlPart)

If Not Found Is Nothing Then
FirstAddress = Found.Address
ListBoxSuchen.ColumnCount = Tabelle1.Range("XEU1:XFD1").Columns.Count
ListBoxSuchen.AddItem Cells(1, 16375)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 1) = Cells(1, 16376)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 2) = Cells(1, 16377)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 3) = Cells(1, 16378)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 4) = Cells(1, 16379)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 5) = Cells(1, 16380)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 6) = Cells(1, 16381)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 7) = Cells(1, 16382)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 8) = Cells(1, 16383)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 9) = Cells(1, 16384)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 10) = Cells(1, 16385)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 11) = Cells(1, 16386)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 12) = Cells(1, 16387)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 13) = Cells(1, 16388)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 14) = Cells(1, 16389)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 15) = Cells(1, 16390)
Do
ListBoxSuchen.AddItem Found
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 0) = Cells(Found.Row, 16375)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 1) = Cells(Found.Row, 16376)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 2) = Cells(Found.Row, 16377)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 3) = Cells(Found.Row, 16378)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 4) = Cells(Found.Row, 16379)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 5) = Cells(Found.Row, 16380)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 6) = Cells(Found.Row, 16381)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 7) = Cells(Found.Row, 16382)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 8) = Cells(Found.Row, 16383)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 9) = Cells(Found.Row, 16384)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 10) = Cells(Found.Row, 16385)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 11) = Cells(Found.Row, 16386)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 12) = Cells(Found.Row, 16387)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 13) = Cells(Found.Row, 16388)
ListBoxSuchen.List(ListBoxSuchen.ListCount - 1, 14) = Cells(Found.Row, 16389)
Set Found = Cells.FindNext(after:=Found)
If Found.Address = FirstAddress Then Exit Do
Loop
End If
End With

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Leider fand ich im Netz wohl vieles zu ListBox, jedoch nicht, wie man die Spalten automatisch anpassen kann.

Besten Dank für eure Ideen.

:)

Beverly · 25. Februar 2015

Hi,

du kannst nur für die Spalte eine Breite vorgeben, nicht jedoch für jede Zeile der ListBox unterschiedliche Spaltenbreiten - genau so wie du im Tabellenblatt nur die Gesamtbreite einer Spalte festlegen kannst und nicht für jede Zelle in derselben Spalte.

Osebi · 25. Februar 2015

Dann habe ich mich falsch ausgedrückt.

Ich möchte nicht für jede Zeile eine eigene, separate Spaltenbreite, sondern für die ganze Spalte in der ListBox

Habe ich 6 Treffer in der ListBox, so soll sich Spalte 1 der längsten Wort anpassen: Spaltenbreite angepasst an Jeremias.

Hans
Ida
Kurt
Jeremias
Evi
Sepp

Bei der nächsten Suche ist in Spalte 1 vielleicht der Name "Antonio Gérard Robin" der längste Name.

Spalte 2 soll sich ebenfalls dem längesten Wort in Spalte 2 anpassen, etc.

Beverly · 25. Februar 2015

Hi,

so ganz genau bekommt man das nicht hin (die Breite in Point hängt ja von vielen Paramtern ab), aber versuche es auf diesem Weg: Code in ein allgemeines Modul

Code:

Option Explicit
' Textbreite mit GetTextExtentPoint bestimmen | Herbers Excel-Forum

Private Type SIZE
cx As Long
cy As Long
End Type

Private Declare Function GetForegroundWindow Lib "user32" () As Long

Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPointA" (ByVal _
hDC As Long, ByVal lpszStr As String, ByVal cchString As Long, lpSize As SIZE) As Long

Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long

Public Function GetTxtPxLen(ByVal sTxt As String) As Long

Dim hWnd As Long
Dim hDC As Long

Dim sz As SIZE

hWnd = GetForegroundWindow()

If hWnd Then
hDC = GetDC(hWnd)
If hDC Then
GetTextExtentPoint32 hDC, sTxt, Len(sTxt), sz
ReleaseDC hWnd, hDC
GetTxtPxLen = sz.cx
End If
End If

End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Und im UserForm z.B. dann diesen prinzipiellen Code:

Code:

Private Sub cmdSuchen_Click()

' hier Code zum Füllen

ListBox1.ColumnWidths = GetTxtPxLen(strText) & " Pt"
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Osebi · 25. Februar 2015

Hoi Beverly

Leider hat der Code nicht funktioniert. Statt dass sich die Spalte dem jeweils längsten Wert anpassen würde, sind nun alle Spalten gleich lang.

Beverly · 25. Februar 2015

Hi,

also bei mir (Excel2013) funktioniert das problemlos.
Ergänze noch die gewünschten (fixen) Breiten für deine restlichen Spalten - vielleicht hilft das.

xlph · 25. Februar 2015

Hallo.

@Berverly
Was beinhaltet 'strText'? Den Wert einer Zelle?

Osebi · 26. Februar 2015

Sind noch gewisse Einstellungen in den Eigenschaften von ListBox zu machen?

Beverly · 26. Februar 2015

Nein.
Aber ich habe gerade gesehen, dass die Variable strText bei der Übergabe an die Function leer ist - sie muss beim Füllen der ListBox belegt werden. Den Teil hatte ich beim Posten vergessen mit zu kopieren. Mein Testbeispiel habe ich nicht mehr vorliegen, aber so sollte es funktionieren (ungetestet):

Code:

Dim strText As String
Dim lngLaenge As Long
Do
If Len(Cells(Round.Row, 16375)) > lngLaenge Then
lngLaenge Len(Cells(Round.Row, 16375)) '
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

xlph · 26. Februar 2015

Hallo Osebi,

also ich kann Beverly's Beispiel nicht folgen.

Hier ein Variante ganz ohne API:

Code:

Private Sub UserForm_Initialize()

Dim rngDaten As Range

With Tabelle1.Range("A1").CurrentRegion
Set rngDaten = Intersect(.Cells, .Offset(1))
End With

With ListBox1
.ColumnCount = rngDaten.Columns.Count
.List = rngDaten.Value
End With

Call SpaltenbreitenSetzen(rngDaten, ListBox1)

End Sub

Private Sub SpaltenbreitenSetzen(rngBereich As Range, lst As MSForms.ListBox)

Dim lngI As Long
Dim lngJ As Long
Dim avarDaten As Variant
Dim astrDaten() As String
Dim txtTB As MSForms.TextBox
Dim strText As String
Dim strSpaltenBreiten As String

Set txtTB = lst.Parent.Controls.Add("Forms.TextBox.1", Visible:=True)

txtTB.AutoSize = True
txtTB.MultiLine = True

With rngBereich

For lngI = 1 To .Columns.Count

If .Rows.Count > 2 ^ 16 Then

avarDaten = .Columns(lngI).Value
ReDim astrDaten(0 To UBound(avarDaten) - 1)
For lngJ = 1 To UBound(avarDaten)
astrDaten(lngJ - 1) = avarDaten(lngJ, 1)
Next lngJ
strText = Join(astrDaten, vbLf)

Else

avarDaten = WorksheetFunction.Transpose(.Columns(lngI))
strText = Join(avarDaten, vbLf)

End If

txtTB.Width = lst.Width
txtTB.Text = strText
DoEvents
strSpaltenBreiten = strSpaltenBreiten & ";" & txtTB.Width

Next lngI

End With

lst.Parent.Controls.Remove txtTB.Name
Set txtTB = Nothing

lst.ColumnWidths = Mid$(strSpaltenBreiten, 2)

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Beverly · 27. Februar 2015

Hi,

in einer Zeile fehlt noch das "=". Das kommt davon, wenn man den Code nicht im Excel kompiliert. *wink.gif*

Ich habe mal ein einfaches Beispiel erstellt. Wenn du in die gelb markierte Zelle einen kürzeren Inhalt einträgst, ändert sich die Breite der 1. Spalte der ListBox.

xlph · 27. Februar 2015

Hallo,

Korrektur:

Code:

Private Sub UserForm_Initialize()

Dim rngDaten As Range

With Tabelle1.Range("A1").CurrentRegion
Set rngDaten = Intersect(.Cells, .Offset(1))
End With

With ListBox1
.ColumnCount = rngDaten.Columns.Count
.List = rngDaten.Value
End With

Call SpaltenbreitenSetzen(rngDaten, ListBox1)

End Sub

Private Sub SpaltenbreitenSetzen(rngBereich As Range, lst As MSForms.ListBox)

Dim lngI As Long
Dim lngJ As Long
Dim avarDaten As Variant
Dim astrDaten() As String
Dim txtTB As MSForms.TextBox
Dim strText As String
Dim strSpaltenBreiten As String

Set txtTB = lst.Parent.Controls.Add("Forms.TextBox.1", Visible:=True)

txtTB.AutoSize = True
txtTB.MultiLine = True

With rngBereich

For lngI = 1 To .Columns.Count

avarDaten = .Columns(lngI).Value
ReDim astrDaten(0 To UBound(avarDaten) - 1)
For lngJ = 1 To UBound(avarDaten)
astrDaten(lngJ - 1) = avarDaten(lngJ, 1)
Next lngJ
strText = Join(astrDaten, vbLf)

txtTB.Width = lst.Width
txtTB.Text = strText
DoEvents
strSpaltenBreiten = strSpaltenBreiten & ";" & txtTB.Width

Next lngI

End With

lst.Parent.Controls.Remove txtTB.Name
Set txtTB = Nothing

lst.ColumnWidths = Mid$(strSpaltenBreiten, 2)

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Osebi · 1. März 2015

Leider habe ich immer noch Darstellungsprobleme mit dem Code von Beverly.

Auch der Code von xlph zeigt mir sämtliche Spalte und sämtliche Zeilen an. Aber - das ist schon sehr gut - die Spalten passen sich der Länge des Inhalts an.

Ich werde nun versuchen, bereits vorhandenes zu vermischen mit dem von Beverly und xlph. Vielleicht komme ich auf dann auf das gewünschte Ergebnis.

Beverly · 1. März 2015

WAS für ein Darstellungsproblem hast du noch? Wie du in den beiden Screenshots sehen kannst, ist die Breite der 1. Spalte im ersten Fall größer als im zweiten, da der Zellinhalt breiter ist.
Die Spaltenbreiten für die anderen Spalten hast du im Code ergänzt?

Office: ListBox: automatische Spaltenbreite

ListBox: automatische Spaltenbreite

ListBox: automatische Spaltenbreite

ListBox: automatische Spaltenbreite

ListBox: automatische Spaltenbreite

ListBox: automatische Spaltenbreite

ListBox: automatische Spaltenbreite - Similar Threads - ListBox automatische Spaltenbreite

Listbox wird nicht breiter, Schriftgrösse ändert sich

Listbox Sortierung

Suchfunktion für Listbox in Textbox

Listbox befüllen

Listbox füllen wenn zelle daneben leer

Ordnernamen, die Kriterien erfüllen in Listbox aufführen

ausgewählte Elemente einer Listbox nach erneutem Aufrufen automatisch markieren