Как добавить заголовки в список из нескольких столбцов в пользовательской форме Excel с помощью VBA

Question

Можно ли настроить заголовки в многоколоночном списке без использования диапазона листа в качестве источника?

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

Sub testMultiColumnLb()
    ReDim arr(1 To 3, 1 To 2)

    arr(1, 1) = "1"
    arr(1, 2) = "One"
    arr(2, 1) = "2"
    arr(2, 2) = "Two"
    arr(3, 1) = "3"
    arr(3, 2) = "Three"


    With ufTestUserForm.lbTest
        .Clear
        .ColumnCount = 2
        .List = arr
    End With

    ufTestUserForm.Show 1
End Sub

Answer 1

Вот один из подходов, который автоматизирует создание надписей над каждым столбцом списка (на рабочем листе).

Это будет работать (хотя и не супер-красиво!), Если в списке нет горизонтальной полосы прокрутки.

Sub Tester()
Dim i As Long

With Me.lbTest
    .Clear
    .ColumnCount = 5
    'must do this next step!
    .ColumnWidths = "70;60;100;60;60"
    .ListStyle = fmListStylePlain
    Debug.Print .ColumnWidths
    For i = 0 To 10
        .AddItem
        .List(i, 0) = "blah" & i
        .List(i, 1) = "blah"
        .List(i, 2) = "blah"
        .List(i, 3) = "blah"
        .List(i, 4) = "blah"
    Next i

End With

LabelHeaders Me.lbTest, Array("Header1", "Header2", _
                     "Header3", "Header4", "Header5")

End Sub

Sub LabelHeaders(lb, arrHeaders)

    Const LBL_HT As Long = 15
    Dim T, L, shp As Shape, cw As String, arr
    Dim i As Long, w

    'delete any previous headers for this listbox
    For i = lb.Parent.Shapes.Count To 1 Step -1
        If lb.Parent.Shapes(i).Name Like lb.Name & "_*" Then
            lb.Parent.Shapes(i).Delete
        End If
    Next i

    'get an array of column widths
    cw = lb.ColumnWidths
    If Len(cw) = 0 Then Exit Sub
    cw = Replace(cw, " pt", "")
    arr = Split(cw, ";")

    'start points for labels
    T = lb.Top - LBL_HT
    L = lb.Left

    For i = LBound(arr) To UBound(arr)
        w = CLng(arr(i))
        If i = UBound(arr) And (L + w) < lb.Width Then w = lb.Width - L
        Set shp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
                                         L, T, w, LBL_HT)
        With shp
            .Name = lb.Name & "_" & i
            'do some formatting
            .Line.ForeColor.RGB = vbBlack
            .Line.Weight = 1
            .Fill.ForeColor.RGB = RGB(220, 220, 220)
            .TextFrame2.TextRange.Characters.Text = arrHeaders(i)
            .TextFrame2.TextRange.Font.Size = 9
            .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = vbBlack
        End With
        L = L + w
    Next i
End Sub

Answer 2

Другой вариант ответа Лунатика - использовать локальное логическое значение и событие изменения, чтобы строка могла быть выделена при инициализации, но отменена и заблокирована после изменения выбора пользователем:

Private Sub lbx_Change()

    If Not bHighlight Then

        If Me.lbx.Selected(0) Then Me.lbx.Selected(0) = False

    End If

    bHighlight = False

End Sub

Когда список инициализируется, вы устанавливаете bHighlight и lbx.Selected (0) = True, что позволит строке заголовка инициализировать выбранное; после этого первое изменение отменяет выбор и предотвращает повторный выбор строки ...