使用列 header 和子 header 填充 TreeView

Question

我是树视图控件的新手，想用 header 列作为 parent 节点和子 header 作为 [=19= 节点填充我的 TreeView（两列） ]节点如图：

我从以下代码开始，但一直坚持下去：

Sub UserForm_Initialize()

    Dim WB As Workbook
    Dim WS As Worksheet
    Dim HeaderRng As Range
    Dim rng As Range
    Dim rCell As Range
    Dim i As Long
    Dim Nod As Node

    Set WB = ThisWorkbook
    Set WS = WB.Worksheets("Data")
    Set HeaderRng = WS.Range("A1:M1")

    With Me.TreeView1.Nodes
        .Clear
        For Each rCell In HeaderRng
            .Add Key:=rCell.Value, Text:=rCell.Value
        Next rCell
    End With

    TreeView1.CheckBoxes = True
    TreeView1.Style = tvwTreelinesPlusMinusText
    TreeView1.BorderStyle = ccFixedSingle

End Sub

Answer 1

感谢您向我介绍 TreeView！在这个 article 的帮助下，我已经根据您的条件进行了处理。

设计视图 |用户窗体的执行：

代码（已更新以适应 HeaderRng 中乱序的组）：

Option Explicit

Sub UserForm_Initialize()
    With Me.TreeView1
        .BorderStyle = ccFixedSingle
        .CheckBoxes = True
        .Style = tvwTreelinesPlusMinusText
        .LineStyle = tvwRootLines
    End With

    UpdateTreeView
End Sub

Private Sub UpdateTreeView()
    Dim WB As Workbook
    Dim WS As Worksheet
    Dim HeaderRng As Range
    Dim rng As Range
    Dim sCurrGroup As String
    Dim sChild As String
    Dim oNode As Node

    Set WB = ThisWorkbook
    Set WS = WB.Worksheets("Data")
    With WS ' Row A are Header/Groups
        Set HeaderRng = Intersect(.Rows(1), .UsedRange)
    End With

    With Me.TreeView1
        With .Nodes
            '.Clear
            sCurrGroup = ""
            For Each rng In HeaderRng
                'Debug.Print "rng: " & rng.Address & " | " & rng.Value
                sCurrGroup = rng.Value
                ' Add Node only if it does NOT exists
                Set oNode = Nothing
                On Error Resume Next
                Set oNode = .Item(sCurrGroup)
                If oNode Is Nothing Then
                    'Debug.Print "Adding Group: " & sCurrGroup
                    .Add Key:=sCurrGroup, Text:=sCurrGroup
                End If
                On Error GoTo 0

                ' Add the Child below the cell
                sChild = rng.Offset(1, 0).Value
                'Debug.Print "Adding [" & sChild & "] to [" & sCurrGroup & "]"
                .Add Relative:=sCurrGroup, Relationship:=tvwChild, Key:=sChild, Text:=sChild
            Next
        End With
        For Each oNode In .Nodes
            oNode.Expanded = True
        Next
    End With

    Set HeaderRng = Nothing
    Set WS = Nothing
    Set WB = Nothing
End Sub

使用列 header 和子 header 填充 TreeView

Populating TreeView with column header and subheader

excel

vba

treeview

populate