Excel ComboBox - Авторазмер Только выпадающий список содержимого - PullRequest
0 голосов
/ 07 ноября 2019

Я ищу способ увеличить выпадающий список в выпадающем списке, чтобы показывать содержимое во всю ширину. Мой выпадающий список имеет заданную ширину для моей пользовательской формы, но когда вы открываете список, содержимое шире, чем раскрывающееся окно.

Мне не повезло заставить этот код работать для моего проекта. Я новичок, и я собираю вещи и пытаюсь узнать о них так, как мне нужно.

Я нашел сообщение, которое делает именно то, что я ищу, но это для массивасписок. Я заполняю свои списки из одного столбца на странице Excel. Excel ComboBox - только выпадающий список с автоматическим изменением размера

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

Есть ли способ изменить это для извлечения данных из моего столбца Excel?

Это изображение показывает, что текст моего списка обрезанпо ширине списка.

enter image description here

Я пытаюсь сделать то, что показано на рисунке ниже. Размер поля со списком остается на форме, но раскрывающийся список больше, чтобы показать полную ширину в моем столбце. enter image description here

1 Ответ

0 голосов
/ 15 ноября 2019

Автоматическое изменение содержимого списка DropDown

Приведенный ниже подход демонстрирует, как

  1. определить необходимый диапазон данных (1 столбец),
  2. присвойте элементы столбца массиву вариантов,
  3. получите отдельные длины строк и извлеките, например, 10 самых длинных строк как набор тестов,
  4. автоматически изменит этот набор в цикле через скрытый текстовый блок, созданный наfly и присвойте все данные свойству combobox'es .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         
...