Frage zu Listbox
05.12.2006 13:47:53
Franc
einer von euch hat mir schonmal ein Makro geschrieben womit ich aus einer Liste Daten in eine Listbox eintragen lassen kann und da auch automatisch die Spaltenbreite angepasst wird. Gibt es eine Möglichkeit das ich auch die 1. Zeile mit der entsprechenden Überschrift mit in die Listbox übernehme? (Zum Beispiel Name, Ort, Plz etc.)
Und wenn es noch geht, sollte man in der Listbox die einzelnen Spalten dann noch nach Name sortieren lassen (A-Z)
Anbei der Code den ich bisher verwende
Private Sub setList()
Dim varList() As Variant
Dim lngRow As Long, lngLast1 As Long, lngLast2 As Long, lngIndex As Long
'letzte Zeile ermitteln
lngLast1 = Cells(Rows.Count, 1).End(xlUp).Row
'Anzahl der Zeilen im Filter ermitteln
lngLast2 = Application.WorksheetFunction.Subtotal(3, ActiveSheet.Range("A2:A" & lngLast1))
ReDim varList(lngLast2 - 1, 22)
For lngRow = 2 To lngLast1
If Rows(lngRow).Hidden = False Then
varList(lngIndex, 0) = Cells(lngRow, 1)
varList(lngIndex, 1) = Cells(lngRow, 3)
varList(lngIndex, 2) = Cells(lngRow, 9)
varList(lngIndex, 3) = Cells(lngRow, 10)
varList(lngIndex, 4) = Cells(lngRow, 14)
varList(lngIndex, 5) = Cells(lngRow, 15)
varList(lngIndex, 6) = Cells(lngRow, 34)
varList(lngIndex, 7) = Cells(lngRow, 6)
varList(lngIndex, 8) = Cells(lngRow, 5)
varList(lngIndex, 9) = Cells(lngRow, 36)
varList(lngIndex, 10) = Cells(lngRow, 33)
varList(lngIndex, 11) = Cells(lngRow, 35)
varList(lngIndex, 12) = Cells(lngRow, 7)
varList(lngIndex, 13) = Cells(lngRow, 22)
varList(lngIndex, 14) = Cells(lngRow, 23)
varList(lngIndex, 15) = Cells(lngRow, 24)
varList(lngIndex, 16) = Cells(lngRow, 25)
varList(lngIndex, 17) = Cells(lngRow, 26)
varList(lngIndex, 18) = Cells(lngRow, 27)
varList(lngIndex, 19) = Cells(lngRow, 28)
varList(lngIndex, 20) = Cells(lngRow, 31)
varList(lngIndex, 21) = Cells(lngRow, 37)
varList(lngIndex, 22) = Cells(lngRow, 38)
lngIndex = lngIndex + 1
End If
Next
If lngIndex > 0 Then
setColCountAndWidth ListBox1, varList
End If
TextBox8 = lngLast2
End Sub
Private Function setColCountAndWidth(ByRef theBox As Object, ByVal theList As Variant, _
Optional setBoxWidth As Boolean = False)
'######## PARAMETER ###########################################################
'~~~~~~~~~~~~~~~~~~~ theBox = List- oder Combo- Box in UF oder Tabelle
'~~~~~~~~~~~~~~~~~~~ theList = Die Liste als Array
'~~~~~~~~~~~~~~~~~~~ setBoxWidth = Breite der Box anpassen
'######## BEISPIEL ############################################################
' setColCountAndWidth Listbox1, myArray, True
' setColCountAndWidth ComboBox1, ComboBox1.List
' setColCountAndWidth Sheets(1).ComboBox1, Sheets(1).ComboBox1.List
Dim iCol As Integer, lRow As Long, dblMax As Double, dblWidth As Double
Dim objDummy As Object
Dim strColWidth As String
If TypeOf theBox.Parent Is MSForms.UserForm Then
Set objDummy = theBox.Parent.Controls.Add("Forms.TextBox.1", "txtDummy", False)
ElseIf TypeOf theBox.Parent Is Worksheet Then
Set objDummy = theBox.Parent.OLEObjects.Add(ClassType:="Forms.TextBox.1", Top:=0, _
Left:=0, Width:=0, Height:=0)
Else
Exit Function
End If
With objDummy
.Visible = False
.Object.Font.Name = theBox.Font.Name
.Object.Font.Size = theBox.Font.Size
.Object.AutoSize = True
.Object.IntegralHeight = False
End With
For iCol = LBound(theList, 2) To UBound(theList, 2)
For lRow = LBound(theList, 1) To UBound(theList, 1)
objDummy.Object.Text = CStr(theList(lRow, iCol))
If objDummy.Width > dblMax Then dblMax = objDummy.Width
Next
dblWidth = dblWidth + dblMax
strColWidth = strColWidth & CStr(dblMax) & ";"
dblMax = 0
Next
With theBox
.ColumnCount = UBound(theList, 2) + IIf(LBound(theList, 2) = 0, 1, 0)
.ColumnWidths = Left(strColWidth, Len(strColWidth) - 1)
.List = theList
If setBoxWidth Then .Width = dblWidth + 5
End With
On Error Resume Next
objDummy.Delete
Set objDummy = Nothing
End Function
Anzeige