如何使用 VBA 将标题添加到 Excel 用户表单中的多列列表框

How to add headers to a multicolumn listbox in an Excel userform using VBA

提问by vzczc

Is it possible to set up the headers in a multicolumn listbox without using a worksheet range as the source?

是否可以在不使用工作表范围作为源的情况下在多列列表框中设置标题？

The following uses an array of variants which is assigned to the list property of the listbox, the headers appear blank.

以下使用分配给列表框的列表属性的变体数组，标题显示为空白。

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

回答by Dick Kusleika

No. I create labels above the listbox to serve as headers. You might think that it's a royal pain to change labels every time your lisbox changes. You'd be right - it is a pain. It's a pain to set up the first time, much less changes. But I haven't found a better way.

不。我在列表框上方创建标签作为标题。您可能认为每次 lisbox 更改时更改标签是一种痛苦。你是对的 - 这是一种痛苦。第一次设置很痛苦，更不用说更改了。但我还没有找到更好的方法。

回答by Jonas_Hess

Here is my approach to solve the problem:

这是我解决问题的方法：

This solution requires you to add a second ListBox element and place it above the first one.

此解决方案要求您添加第二个 ListBox 元素并将其放置在第一个元素之上。

Like this:

像这样：

Then you call the function CreateListBoxHeader to make the alignment correct and add header items.

然后调用函数 CreateListBoxHeader 使对齐正确并添加标题项。

Result:

结果：

Code:

代码：

  Public Sub CreateListBoxHeader(body As MSForms.ListBox, header As MSForms.ListBox, arrHeaders)
            ' make column count match
            header.ColumnCount = body.ColumnCount
            header.ColumnWidths = body.ColumnWidths

        ' add header elements
        header.Clear
        header.AddItem
        Dim i As Integer
        For i = 0 To UBound(arrHeaders)
            header.List(0, i) = arrHeaders(i)
        Next i

        ' make it pretty
        body.ZOrder (1)
        header.ZOrder (0)
        header.SpecialEffect = fmSpecialEffectFlat
        header.BackColor = RGB(200, 200, 200)
        header.Height = 10

        ' align header to body (should be done last!)
        header.Width = body.Width
        header.Left = body.Left
        header.Top = body.Top - (header.Height - 1)
End Sub

Usage:

用法：

Private Sub UserForm_Activate()
    Call CreateListBoxHeader(Me.listBox_Body, Me.listBox_Header, Array("Header 1", "Header 2"))
End Sub

回答by Rick Henderson

I was looking at this problem just now and found this solution. If your RowSourcepoints to a range of cells, the column headings in a multi-column listbox are taken from the cells immediately above the RowSource.

我刚才在看这个问题，找到了这个解决方案。如果您的RowSource指向一系列单元格，则多列列表框中的列标题取自 RowSource 正上方的单元格。

Using the example pictured here, inside the listbox, the words Symboland Nameappear as title headings. When I changed the word Name in cell AB1, then opened the form in the VBE again, the column headings changed.

使用此处所示的示例，在列表框中，符号和名称这两个词显示为标题标题。当我更改单元格 AB1 中的单词 Name，然后再次在 VBE 中打开表单时，列标题发生了变化。

The example came from a workbook in VBA For Modelers by S. Christian Albright, and I was trying to figure out how he got the column headings in his listbox :)

这个例子来自 S. Christian Albright 在 VBA For Modelers 中的一本工作簿，我试图弄清楚他是如何在他的列表框中获得列标题的 :)

回答by Asif Hameed

There is very easy solution to show headers at the top of multi columns list box. Just change the property value to "true" for "columnheads" which is false by default.

在多列列表框的顶部显示标题有一个非常简单的解决方案。只需将“columnheads”的属性值更改为“true”，默认情况下为 false。

After that Just mention the data range in property "rowsource" excluding header from the data range and header should be at first top row of data range then it will pick the header automatically and you header will be freezed.

之后只需提到属性“rowsource”中的数据范围，从数据范围中排除标题，标题应该在数据范围的第一行，然后它会自动选择标题，你的标题将被冻结。

if suppose you have data in range "A1:H100" and header at "A1:H1" which is the first row then your data range should be "A2:H100" which needs to mention in property "rowsource" and "columnheads" perperty value should be true

如果假设您有“A1:H100”范围内的数据和第一行“A1:H1”的标题，那么您的数据范围应该是“A2:H100”，需要在属性“rowsource”和“columnheads”属性中提及值应该是真的

Regards, Asif Hameed

问候， 阿西夫·哈米德

回答by Lunatik

Simple answer: no.

简单的回答：没有。

What I've done in the past is load the headings into row 0 then set the ListIndex to 0 when displaying the form. This then highlights the "headings" in blue, giving the appearance of a header. The form action buttons are ignored if the ListIndex remains at zero, so these values can never be selected.

我过去所做的是将标题加载到第 0 行，然后在显示表单时将 ListIndex 设置为 0。然后以蓝色突出显示“标题”，呈现标题的外观。如果 ListIndex 保持为零，则表单操作按钮将被忽略，因此永远无法选择这些值。

Of course, as soon as another list item is selected, the heading loses focus, but by this time their job is done.

当然，一旦选择了另一个列表项，标题就会失去焦点，但此时他们的工作已经完成。

Doing things this way also allows you to have headings that scroll horizontally, which is difficult/impossible to do with separate labels that float above the listbox. The flipside is that the headings do not remain visible if the listbox needs to scroll vertically.

以这种方式做事还允许您拥有水平滚动的标题，这对于浮动在列表框上方的单独标签来说是困难/不可能的。另一方面，如果列表框需要垂直滚动，则标题不会保持可见。

Basically, it's a compromise that works in the situations I've been in.

基本上，这是一种适用于我遇到的情况的折衷方案。

回答by RR_CodeSlinger

I like to use the following approach for headers on a ComboBox where the CboBx is not loaded from a worksheet (data from sql for example). The reason I specify not from a worksheet is that I think the only way to get RowSource to work is if you load from a worksheet.

我喜欢对 ComboBox 上的标题使用以下方法，其中 CboBx 不是从工作表加载的（例如来自 sql 的数据）。我不是从工作表指定的原因是我认为让 RowSource 工作的唯一方法是从工作表加载。

This works for me:

这对我有用：

1. Create your ComboBox and create a ListBox with an identical layout but just one row.
2. Place the ListBox directly on top of the ComboBox.
3. In your VBA, load ListBox row1 with the desired headers.

4. In your VBA for the action yourListBoxName_Click, enter the following code:

   yourComboBoxName.Activate`
   yourComboBoxName.DropDown`
   

5. When you click on the listbox, the combobox will drop down and function normally while the headings (in the listbox) remain above the list.

1. 创建您的 ComboBox 并创建一个具有相同布局但只有一行的 ListBox。
2. 将 ListBox 直接放在 ComboBox 的顶部。
3. 在您的 VBA 中，加载带有所需标题的 ListBox row1。

4. 在操作 yourListBoxName_Click 的 VBA 中，输入以下代码：

   yourComboBoxName.Activate`
   yourComboBoxName.DropDown`
   

5. 当您单击列表框时，组合框将下拉并正常运行，而标题（在列表框中）保持在列表上方。

回答by Tim Williams

Here's one approach which automates creating labels above each column of a listbox (on a worksheet).

这是一种自动在列表框（在工作表上）的每一列上方创建标签的方法。

It will work (though not super-pretty!) as long as there's no horizontal scrollbar on your listbox.

只要列表框上没有水平滚动条，它就可以工作（虽然不是超级漂亮！）。

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

回答by Jim

Why not just add Labels to the top of the Listbox and if changes are needed, the only thing you need to programmatically change are the labels.

为什么不将标签添加到列表框的顶部，如果需要更改，您唯一需要以编程方式更改的就是标签。

回答by ChE Junkie

Another variant on Lunatik's response is to use a local boolean and the change event so that the row can be highlighted upon initializing, but deselected and blocked after a selection change is made by the user:

Lunatik 响应的另一个变体是使用本地布尔值和更改事件，以便在初始化时可以突出显示该行，但在用户进行选择更改后取消选择和阻止：

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

When the listbox is initialized you then set bHighlight and lbx.Selected(0) = True, which will allow the header-row to initialize selected; afterwards, the first change will deselect and prevent the row from being selected again...

当列表框被初始化时，然后设置 bHighlight 和 lbx.Selected(0) = True，这将允许标题行初始化选定；之后，第一次更改将取消选择并防止再次选择该行...

回答by Peter Winn

You can give this a try. I am quite new to the forum but wanted to offer something that worked for me since I've gotten so much help from this site in the past. This is essentially a variation of the above, but I found it simpler.

你可以试试这个。我对论坛很陌生，但想提供一些对我有用的东西，因为我过去从这个网站得到了很多帮助。这本质上是上述的变体，但我发现它更简单。

Just paste this into the Userform_Initialize section of your userform code. Note you must already have a listbox on the userform or have it created dynamically above this code. Also please note the Array is a list of headings (below as "Header1", "Header2" etc. Replace these with your own headings. This code will then set up a heading bar at the top based on the column widths of the list box. Sorry it doesn't scroll - it's fixed labels.

只需将其粘贴到用户表单代码的 Userform_Initialize 部分即可。请注意，您必须在用户窗体上已经有一个列表框，或者在此代码上方动态创建它。另请注意 Array 是一个标题列表（以下为“Header1”、“Header2”等。将它们替换为您自己的标题。此代码将根据列表框的列宽在顶部设置一个标题栏. 抱歉，它不滚动——它是固定标签。

More senior coders - please feel free to comment or improve this.

更多高级编码员 - 请随时对此发表评论或改进。

    Dim Mywidths As String
    Dim Arrwidths, Arrheaders As Variant
    Dim ColCounter, Labelleft As Long
    Dim theLabel As Object                

    [Other code here that you would already have in the Userform_Initialize section]

    Set theLabel = Me.Controls.Add("Forms.Label.1", "Test" & ColCounter, True)
            With theLabel
                    .Left = ListBox1.Left
                    .Top = ListBox1.Top - 10
                    .Width = ListBox1.Width - 1
                    .Height = 10
                    .BackColor = RGB(200, 200, 200)
            End With
            Arrheaders = Array("Header1", "Header2", "Header3", "Header4")

            Mywidths = Me.ListBox1.ColumnWidths
            Mywidths = Replace(Mywidths, " pt", "")
            Arrwidths = Split(Mywidths, ";")
            Labelleft = ListBox1.Left + 18
            For ColCounter = LBound(Arrwidths) To UBound(Arrwidths)
                        If Arrwidths(ColCounter) > 0 Then
                                Header = Header + 1
                                Set theLabel = Me.Controls.Add("Forms.Label.1", "Test" & ColCounter, True)

                                With theLabel
                                    .Caption = Arrheaders(Header - 1)
                                    .Left = Labelleft
                                    .Width = Arrwidths(ColCounter)
                                    .Height = 10
                                    .Top = ListBox1.Top - 10
                                    .BackColor = RGB(200, 200, 200)
                                    .Font.Bold = True
                                End With
                                 Labelleft = Labelleft + Arrwidths(ColCounter)

                        End If
             Next