是否可以在不使用工作表范围作为源的情况下在多列列表框中设置标题？
下面使用一个变量数组，分配给列表框的列表属性，标题显示为空白。
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
【问题讨论】：
没有。我在列表框上方创建标签作为标题。您可能认为每次 lisbox 更改时都更改标签是一件非常痛苦的事情。你是对的 - 这是一种痛苦。第一次设置很痛苦，更不用说更改了。但是我还没有找到更好的方法。
【讨论】：
此解决方案要求您添加第二个 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
【讨论】：
For i = LBound(arrHeaders) To UBound(arrHeaders) ' Changed to use LBound header.List(0, i - 1) = arrHeaders(i) ' Changed to i - 1
header.Locked=True，以避免用户弄乱它。
我刚才在看这个问题并找到了这个解决方案。如果您的 RowSource 指向一系列单元格，则多列列表框中的列标题取自 RowSource 正上方的单元格。
使用此处图示的示例，在列表框中，Symbol 和 Name 两个词显示为标题标题。当我更改单元格 AB1 中的名称，然后再次在 VBE 中打开表单时，列标题发生了变化。
该示例来自 S. Christian Albright 的 VBA For Modelers 工作簿，我试图弄清楚他是如何在列表框中获取列标题的：)
【讨论】：
简单的回答：没有。
我过去所做的是将标题加载到第 0 行，然后在显示表单时将 ListIndex 设置为 0。然后以蓝色突出显示“标题”，呈现标题的外观。如果 ListIndex 保持为零，则表单操作按钮将被忽略，因此永远无法选择这些值。
当然，一旦选择了另一个列表项，标题就会失去焦点，但此时他们的工作已经完成。
这样做还可以让标题水平滚动，这对于浮动在列表框上方的单独标签来说是困难/不可能的。不利的一面是，如果列表框需要垂直滚动，标题不会保持可见。
基本上，这是一种妥协，适用于我所遇到的情况。
【讨论】：
在多列列表框顶部显示标题非常简单。 只需将“columnheads”的属性值更改为“true”，默认情况下为 false。
之后只需在属性“rowsource”中提及数据范围，不包括数据范围中的标头，并且标头应位于数据范围的第一行，然后它将自动选择标头，您的标头将被冻结。
如果假设您在“A1:H100”范围内有数据，并且标题在“A1:H1”这是第一行，那么您的数据范围应该是“A2:H100”，这需要在属性“rowsource”中提及" 和 "columnheads" 属性值应该是 true
问候， 阿西夫·哈米德
【讨论】：
我喜欢将以下方法用于未从工作表加载 CboBx 的 ComboBox 上的标题（例如，来自 sql 的数据）。我不从工作表指定的原因是，我认为让 RowSource 工作的唯一方法是从工作表加载。
这对我有用：
在您的 VBA 中为 yourListBoxName_Click 操作输入以下代码：
yourComboBoxName.Activate`
yourComboBoxName.DropDown`
当您单击列表框时，组合框将下拉并正常工作，而标题（在列表框中）仍位于列表上方。
【讨论】：
我一直在寻找一种解决方案来添加标题而不使用单独的工作表并将所有内容复制到用户表单中。
我的解决方案是使用第一行作为标题并通过 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 列的列表框。不理想，但它可以工作，当您必须水平滚动时，“标题”会停留在行上方。
【讨论】：
这是我的解决方案。
我注意到，当我通过 VBE 中的属性窗口指定列表框的行源时，标题弹出没有问题。只有当我们尝试通过 VBA 代码定义行源时，标头才会丢失。
所以我首先通过属性窗口将列表框行源定义为 VBE 中的命名范围，然后我可以在 VBA 代码中重置行源。标题仍然每次都显示。
我将它与来自列表对象的高级过滤器宏结合使用，然后创建另一个（过滤的）列表对象作为行源的基础。
这对我有用
【讨论】：
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，这将允许标题行初始化选中；之后，第一次更改将取消选择并防止再次选择该行...
【讨论】：
这是一种自动在列表框的每一列上方（在工作表上）创建标签的方法。
只要列表框上没有水平滚动条，它就可以工作（虽然不是超级漂亮！）。
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
【讨论】：
你可以试试这个。我对论坛很陌生，但我想提供一些对我有用的东西，因为我过去从这个网站得到了很多帮助。这本质上是上述的变体，但我发现它更简单。
只需将其粘贴到用户表单代码的 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
【讨论】：
这是一个无赖。必须使用中间表来放入数据，以便 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
【讨论】：
对于滚动，一个想法是创建一个模拟滚动条，它可以左右移动整个列表框。
为此，您需要能够用框架覆盖预期查看空间的左右两侧，以便列表框可以在其下方通过并保留表单中的任何水平框架。这变得具有挑战性，因为让框架覆盖列表框似乎并不容易。我当时放弃了，但我将这些步骤分享给后代。
【讨论】：
为什么不直接将标签添加到列表框的顶部，如果需要更改，您唯一需要以编程方式更改的就是标签。
【讨论】：