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

為什么不直接將標簽添加到列表框的頂部，如果需要更改，您唯一需要以編程方式更改的就是標簽。