时间戳

首页 > 解决方案 > 仅在 ComboBox 中自动调整下拉列表内容的大小

excel - 仅在 ComboBox 中自动调整下拉列表内容的大小

问题描述

我正在寻找一种方法来扩大组合框的下拉列表以显示全宽内容。我的组合框是我的用户窗体上的设置宽度，但是当您打开列表时，内容比下拉窗口宽。

我找到了一个帖子，它可以满足我的需求，但它是针对数组列表的。 Excel ComboBox - 仅自动调整下拉列表。我正在从 Excel 页面中的单个列填充我的列表。

Private Sub ConfigureComboBox()
    Dim arrData, arrWidths
    Dim x As Long, y As Long, ListWidth As Double
    arrData = ComboBox1.List
    ReDim arrWidths(UBound(arrData, 2))
    
    For x = 0 To UBound(arrData, 1)
        For y = 0 To UBound(arrData, 2)
            If Len(arrData(x, y)) > arrWidths(y) Then arrWidths(y) = Len(arrData(x, y))
        Next
    Next
    
    For y = 0 To UBound(arrWidths)
        arrWidths(y) = arrWidths(y) * ComboBox1.Font.Size
        ListWidth = ListWidth + arrWidths(y)
    Next
    
    With ComboBox1
        .ColumnCount = UBound(arrWidths) + 1
        .ColumnWidths = Join(arrWidths, ";")
        .ListWidth = ListWidth
    End With
    
End Sub

文本被列表宽度截断。
在此处输入图像描述

我正在尝试这样做。 组合框保持表单上的大小，但下拉列表更大以在我的列中显示完整的文本。
在此处输入图像描述

标签： excelvbauserform

解决方案

自动调整下拉列表内容

下面的方法演示了如何

  1. 定义所需的数据范围（1 列），
  2. 将列项分配给变量数组，
  3. 获取单个字符串长度并提取例如 10 个最长的字符串作为测试集，
  4. 通过动态创建的隐藏文本框在循环中自动调整此集的大小，并将所有数据分配给组合框的.List属性。
Sub ConfigureCombo(ByRef myComboBox As MSForms.ComboBox, _
                   mySheet As Worksheet, _
                   Optional myCol$ = "A", _
                   Optional myFontSize# = 10, Optional Startrow& = 2)
' Purpose: assign autosized items to combobox (by testing the n longest items)
' Note:    neglects a possible title row by default if no explicit Startrow argument is passed
' Author:  T.M. 2019-11-15 (https://stackoverflow.com/users/6460297/t-m)
  ' [1] Define data range and set object to memory
    Dim rng As Range, lastRow&
    lastRow = mySheet.Range(myCol & mySheet.Rows.Count).End(xlUp).Row
    Set rng = mySheet.Range(myCol & Startrow & ":" & myCol & lastRow)  ' e.g. Sheet1.Range("B2:B6")
  ' [2] Get strings
    Dim v                                               ' declare variant array to hold strings
    v = rng.Value2                                      ' assign data to 1-based 2-dim array
  ' [3] Get string lengths
    Dim lengths                                         ' declare variant array to hold lengths
    lengths = Application.Transpose(Evaluate("len('" & _
              rng.Cells.Parent.Name & "'!" & rng.Address & ")"))
  ' [4] Autosize e.g. the 10 longest strings via testing text box created on the fly
    With Me.Controls.Add("Forms.TextBox.1", "myTextBox") ' testing text box on the fly
        myComboBox.Font.Size = myFontSize                ' assign identical font sizes
        .Font.Size = myFontSize                          '
        .Top = -100                                      ' hide newly created textbox

        Dim n&, pos&, optWidth#
        For n = 1 To 10                                  ' check e.g. the 10 longest strings
            If n > UBound(lengths) Then Exit For         ' escape if less items than n
            pos = Application.Match(Application.Large(lengths, n), _
                lengths, 0)                              ' find nth position in lengths array
            lengths(pos) = lengths(pos) + 0.01           ' remove current length from lengths set
            .Text = v(pos, 1)                            ' enter next longest string to test textbox
            .AutoSize = True                             ' autosize test string
            If .Width + 6 > optWidth Then optWidth = .Width + 6
        Next n
    End With
  ' [5] Correct to final combobox width and assign data
    myComboBox.Width = optWidth                         ' assign best fit width
    myComboBox.List = v                                 ' assign data to combobox
End Sub

示例调用

使用工作表CodeName（例如Sheet1）的可能示例调用，指的是数据列B以及 16 磅的字体大小，可能如下（您可能希望通过命令按钮单击事件或也从初始化事件调用它）：

ConfigureCombo Me.ComboBox1, Sheet1, myCol:="B", myFontSize:=16

推荐阅读