如何使用VBA将标题添加到Excel用户窗体中的多列列表框
是否可以在多列列表框中设置标题而不使用工作表范围作为源？
以下使用分配给列表框属性的variables数组，标题显示为空白。
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 不，我在列表框上面创build标签作为标题。 你可能会认为，每当你的lisbox改变时，改变标签是一件非常痛苦的事情。 你是对的 – 这是一个痛苦。 第一次设置是一种痛苦，更不用说改变了。 但我还没有find更好的办法。
简单的回答：不。
我过去所做的是将标题加载到第0行，然后在显示表单时将ListIndex设置为0。 然后用蓝色突出显示“标题”，表示标题。 如果ListIndex保持为零，则表单操作button将被忽略，因此这些值不能被选中。
当然，只要select了另一个列表项目，标题就会失去焦点，但是到了这个时候他们的工作就完成了。
这样做的事情也可以让你有水平滚动的标题，这是很难/不可能做到浮动在列表框上的单独的标签。 另一方面是，如果列表框需要垂直滚动，则标题不会保持可见。
基本上，这是一个妥协，适用于我所处的情况。
我刚才看到这个问题，发现这个解决scheme。 如果您的RowSource指向一个单元格范围，多列列表框中的列标题是从行源上方的单元格中获取的。
使用此处示例中的示例，在列表框中， 符号和名称将显示为标题标题。 当我在单元格AB1中更改单词名称，然后再次在VBE中打开窗体时，列标题已更改。
这个例子来自于S. Christian Albright在VBA For Modelers中的工作手册，我试图弄清楚他是如何在列表框中获得列标题的。
有很容易的解决scheme来显示在多列列表框顶部的标题。 只需将属性值更改为“true”，默认为false。
之后，只需提到属性“rowsource”中的数据范围，不包括数据范围的标题，标题应该在数据范围的第一行，然后它将自动select标题，并且标题将被冻结。
如果假设你的数据范围是“A1：H100”，头是“A1：H1”，那么你的数据范围应该是“A2：H100”，这个数据范围在属性“rowsource”和“columnheads”perperty中需要提及价值应该是真实的
问候，阿西夫Hameed
我喜欢使用下面的方法在ComboBox上的CboBx不从工作表加载（例如，来自sql的数据）的头文件。 我没有从工作表中指定的原因是我认为让RowSource工作的唯一方法是从工作表加载。
这适用于我：
- 创build您的combobox，并创build一个相同的布局，但只有一行的列表框。
- 将列表框直接放置在combobox的顶部。
- 在你的VBA中，加载ListBox row1和所需的头文件。
-
在您的VBA中，为action yourListBoxName_Clickinput以下代码：
yourComboBoxName.Activate` yourComboBoxName.DropDown` -
当您单击列表框时，combobox将下拉并正常运行，而标题（在列表框中）保持在列表的上方。
这是我解决问题的方法：
此解决scheme要求您添加第二个ListBox元素，并将其放在第一个之上。
喜欢这个：
然后调用CreateListBoxHeader函数使alignment正确并添加标题项。
结果：
码：
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
Lunatik响应的另一个变体是使用本地布尔值和更改事件，以便在初始化时突出显示行，但在用户进行select更改后取消select和屏蔽：
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，这将允许标题行初始化select; 之后，第一次更改将取消select并防止再次select该行。
这里有一种方法可以在列表框的每一列（工作表）上自动创build标签。
只要列表框中没有水平滚动条，它就会工作（尽pipe不是超级漂亮！）。
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
为什么不把标签添加到列表框的顶部，如果需要更改，则需要以编程方式更改的唯一内容就是标签。