Automatically adapt listbox column width

问题

I programmatically add elements from a database to a multicolumn listbox using this code :

Do While (Not rs.EOF) 

        ExistingSheetsListBox.AddItem
        ExistingSheetsListBox.List(i, 0) = rs.Fields(0)
        ExistingSheetsListBox.List(i, 1) = rs.Fields(1)
        ExistingSheetsListBox.List(i, 2) = rs.Fields(2)
        ExistingSheetsListBox.List(i, 3) = rs.Fields(3)
        ExistingSheetsListBox.List(i, 4) = rs.Fields(4)

        i = i + 1

        rs.MoveNext
Loop

The insertion in the listbox works fine, but the column width is not always adapted to the length of the elements inserted in it, I would like to know how I can do so that the column width of each column is adapted to the text inserted into it.

EDIT : I used the solution proposed by @Excel Developers with the piece of code given by @HarveyFrench.

回答1:

You can use the ColumnWidths property to set the size of the columns.

eg `ExistingSheetsListBox.ColumnWidths = "60;60;160;160;60"

For more info see here

I have not found anyway to automatically set the widths depending ont he data in each column, and I am pretty sure such a method does not exist.

回答2:

There is no autosize option, following sample code shows 2 ways to do this.

This does not take into account anything other than being a sample.

Class Module clsListCtrlWidths

'class option used so we can use Collection instead of an array.
Option Explicit
Public m_ColWidthMax As Long

Forms Module. Initialise somewhere

Dim l_ColumnWidths As Collection
Set l_ColumnWidths = New Collection

Forms Module functions

Private Function SetColWidth(stLen As String, ctCol1 As control, lPosCol As Long) As String
    Dim stWidthTemp As String

    If lPosCol > 0 Then
        stWidthTemp = stLen & ";"
    End If

    Dim lTmpWidth As Long
    Dim lColWidth As Long
    lTmpWidth = ctCol1.Width
    ctCol1.AutoSize = True
    lColWidth = ctCol1.Width
    ctCol1.AutoSize = False
    ctCol1.Width = lTmpWidth

    If l_ColumnWidths.Count > lPosCol Then
        If l_ColumnWidths.Item(lPosCol + 1).m_ColWidthMax < lColWidth Then
            l_ColumnWidths.Item(lPosCol + 1).m_ColWidthMax = lColWidth
        Else
            lColWidth = l_ColumnWidths.Item(lPosCol + 1).m_ColWidthMax
        End If
    Else
        Dim clsColWidth As clsListCtrlWidths
        Set clsColWidth = New clsListCtrlWidths
        clsColWidth.m_ColWidthMax = lColWidth
        l_ColumnWidths.Add clsColWidth
    End If

    stWidthTemp = stWidthTemp & lColWidth
    SetColWidth = stWidthTemp
End Function

Following function takes listbox & calls on above function;

Private Function AutoSizeColsWidth(ByRef ctListCtrl As MSForms.ListBox)
    Dim txtBoxDummy As control
    Set txtBoxDummy = Me.Controls.Add("Forms.TextBox.1", "txtBoxDummy", False)
    txtBoxDummy.AutoSize = True

    Dim lRow As Long
    Dim lCol As Long
    Dim strColWidth As String

    For lRow = 0 To ctListCtrl.ListCount - 1
        For lCol = 0 To ctListCtrl.ColumnCount - 1
            txtBoxDummy = ctListCtrl.List(lRow, lCol)
            strColWidth = SetColWidth(strColWidth, txtBoxDummy, lCol)
        Next lCol
    Next lRow

    ctListCtrl.ColumnWidths = strColWidth

End Function

Size Each time you add a single item

'assumes rs.Fields is a control or converted to control
Dim strColWidth As String
strColWidth = SetColWidth(strColWidth, rs.Fields(0), 0)
strColWidth = SetColWidth(strColWidth, rs.Fields(1), 1)
strColWidth = SetColWidth(strColWidth, rs.Fields(2), 2)
strColWidth = SetColWidth(strColWidth, rs.Fields(3), 3)
'etc
ctListCtrl.ColumnWidths = strColWidth

Or size once after adding lot of items

Call AutoSizeColsWidth(myListBox) 'call after completely loading listbox

Added as I was looking for a way to do this & OP is Google's top answer.

来源：https://stackoverflow.com/questions/32183087/automatically-adapt-listbox-column-width

标签

excel

vba

excel-vba