如何使用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

我刚刚看到这个问题并找到了这个解决方案。如果 RowSource 指向一系列单元格，则多列列表框中的列标题将从紧靠RowSource上方的单元格中获取。

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

这个例子来自S. Christian Albright的VBA For Modelers工作簿，我试图找出他是如何在列表框中找到列标题的：）

Answer 3

简单回答：不。

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

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

以这种方式执行操作还允许您具有水平滚动的标题，这对于浮动在列表框上方的单独标签很难/不可能。另一方面，如果列表框需要垂直滚动，则标题不会保持可见。

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

Answer 4

在多列列表框的顶部显示标题非常简单。 只需将属性值更改为＆＃34; true＆＃34;对于＃34;柱头＆＃34;默认为假。

之后只需提及属性中的数据范围＆＃34; rowsource＆＃34;从数据范围和标题中排除标题应位于数据范围的第一行，然后它将自动选择标题，并且标题将被冻结。

如果您认为数据范围为＆＃34; A1：H100＆＃34;标题为＆＃34; A1：H1＆＃34;这是第一行，那么你的数据范围应该是＆＃34; A2：H100＆＃34;需要在财产中提及＆＃34; rowsource＆＃34;和＃34;柱头＆＃34; perperty值应该是真的

此致 Asif Hameed

Answer 5

以下是解决问题的方法：

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

像这样：

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

<强>结果：

代码：

  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 6

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

这对我有用：

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

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

   yourComboBoxName.Activate`
   yourComboBoxName.DropDown`
   

5. 当您点击列表框时，组合框将下拉并正常运行，而标题（在列表框中）仍然位于列表上方。

Answer 7

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

当列表框初始化时，然后设置bHighlight和lbx.Selected（0）= True，这将允许标题行初始化选中;之后，第一个更改将取消选择并阻止再次选择行...

Answer 8

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

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

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 9

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

Answer 10

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

只需将其粘贴到用户表单代码的Userform_Initialize部分即可。请注意，您必须已在userform上有一个列表框，或者在此代码之上动态创建它。另请注意，数组是一个标题列表（下面为＆＃34; Header1＆＃34;，＆＃34; Header2＆＃34;等等。用您自己的标题替换它们。此代码将在此处设置标题栏。顶部基于列表框的列宽。抱歉它不会滚动 - 它的固定标签。

更多高级程序员 - 请随时评论或改进。

    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 11

我花了很长时间寻找一种解决方案，以添加标题而不使用单独的工作表并将所有内容复制到用户表单中。

我的解决方案是将第一行用作标题，并通过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 12

这是我的解决方法。

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

因此，我首先通过属性窗口在VBE中将列表框行源定义为命名范围，然后在VBA代码中重置行源。标题仍然会每次显示。

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

这对我有用

Answer 13

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

1. 用于标题-将RowSource属性设置为第一行，例如问题！Q4：S4

2. 用于数据-将“行源”属性设置为“事件”！Q5：S10

对“ 3-frmSpecialEffectsEtched”的特殊效果

Answer 14

这是一个无赖。必须使用中间表将数据放入，以便 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