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

Question

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

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

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

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

Answer 2

这是我解决问题的方法：

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

像这样：

然后调用 function CreateListBoxHeader 以使 alignment 正确并添加 header 项。

结果：

代码：

  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

用法：

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

Answer 3

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

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

该示例来自 S. Christian Albright 的 VBA For Modelers 中的工作簿，我试图弄清楚他是如何在列表框中获得列标题的：）

Answer 4

简单的回答：没有。

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

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

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

基本上，这是一种妥协，适用于我所经历的情况。

Answer 5

有一个非常简单的解决方案可以在多列列表框的顶部显示标题。 只需将“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.

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

问候， 阿西夫·哈米德

Answer 6

只需使用两个列表框，一个用于 header，另一个用于数据

1. 对于标题 - 将 RowSource 属性设置为顶行，例如 Incidents:Q4:S4

2. 对于数据 - 将行源属性设置为 Incidents:Q5:S10

“3-frmSpecialEffectsEtched”的特殊效果

Answer 7

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

这对我有用：

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

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

    yourComboBoxName.Activate` yourComboBoxName.DropDown`

5. 当您单击列表框时，combobox 将下拉，function 通常会下降，而标题（在列表框中）仍位于列表上方。

Answer 8

我一直在寻找一种解决方案来添加 header 而不使用单独的工作表并将所有内容复制到用户表单中。

我的解决方案是将第一行用作 header 并通过 if 条件运行它并在下面添加其他项目。

像那样：

 If lborowcount = 0 Then With lboorder.ColumnCount = 5.AddItem.Column(0, lborowcount) = "Item".Column(1, lborowcount) = "Description".Column(2, lborowcount) = "Ordered".Column(3, lborowcount) = "Rate".Column(4, lborowcount) = "Amount" End With lborowcount = lborowcount + 1 End If With lboorder.ColumnCount = 5.AddItem.Column(0, lborowcount) = itemselected.Column(1, lborowcount) = descriptionselected.Column(2, lborowcount) = orderedselected.Column(3, lborowcount) = rateselected.Column(4, lborowcount) = amountselected End With lborowcount = lborowcount + 1

在该示例中， lboorder 是列表框， lborowcount 计数添加下一个列表框项目的行。 这是一个 5 列的列表框。 不理想，但它有效，当您必须水平滚动时，“标题”保持在行上方。

Answer 9

这是我的解决方案。

我注意到，当我通过 VBE 中的属性 window 指定列表框的行源时，标题弹出没有问题。 只有当我们尝试通过 VBA 代码定义行源时，标头才会丢失。

所以我首先通过属性 window 将列表框行源定义为 VBE 中的命名范围，然后我可以在 VBA 代码中重置行源。 标题仍然每次都出现。

我将它与来自列表对象的高级过滤器宏结合使用，然后创建另一个（过滤的）列表对象，行源所基于的列表对象。

这对我有用

Answer 10

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

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，这将允许标题行初始化选中； 之后，第一次更改将取消选择并防止再次选择该行...

Answer 11

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

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

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 12

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

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

更高级的编码人员 - 请随时发表评论或改进。

    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

Answer 13

这是一个无赖。 必须使用中间表将数据放入，以便 Excel 知道获取标题。 但是我希望隐藏该工作簿，所以这就是我必须执行行源的方法。 大部分代码只是设置...

Sub listHeaderTest()
Dim ws As Worksheet
Dim testarr() As String
Dim numberOfRows As Long
Dim x As Long, n As Long

'example sheet
Set ws = ThisWorkbook.Sheets(1)
'example headers
For x = 1 To UserForm1.ListBox1.ColumnCount
    ws.Cells(1, x) = "header" & x
Next x
'example array dimensions
numberOfRows = 15
ReDim testarr(numberOfRows, UserForm1.ListBox1.ColumnCount - 1)
'example values for the array/listbox
For n = 0 To UBound(testarr)
    For x = 0 To UBound(testarr, 2)
        testarr(n, x) = "test" & n & x
    Next x
Next n

'put array data into the worksheet
ws.Range("A2").Resize(UBound(testarr), UBound(testarr, 2) + 1) = testarr

'provide rowsource
UserForm1.ListBox1.RowSource = "'[" & ws.Parent.Name & "]" & ws.Name & "'!" _
& ws.Range("A2").Resize(ws.UsedRange.Rows.Count - 1, ws.UsedRange.Columns.Count).Address

UserForm1.Show

End Sub

Answer 14

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