自动调整列表框列宽

Question

我使用以下代码以编程方式将数据库中的元素添加到多列列表框：

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

列表框中的插入工作正常，但列宽并不总是适应插入其中的元素的长度，我想知道如何才能使每列的列宽适应插入的文本它。

编辑：我使用了@Excel Developers提出的解决方案以及@HarveyFrench给出的代码段。

Answer 1

没有自动调整大小选项，以下示例代码显示了执行此操作的两种方法。

除了作为样本之外，这没有考虑任何其他因素。

类模块 clsListCtrlWidths

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

表格模块。在某处初始化

Dim l_ColumnWidths As Collection
Set l_ColumnWidths = New Collection

表单模块功能

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

以下函数采用列表框并调用上述函数；

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

1. 尺寸 每次添加单个项目时

   '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
   

2. 或者添加大量物品后调整一次尺寸

   Call AutoSizeColsWidth(myListBox) 'call after completely loading listbox
   

添加是因为我正在寻找一种方法来做到这一点，OP 是 Google 的最佳答案。