使用列标题和子标题填充TreeView

时间:2015-11-05 21:46:10

标签: excel vba treeview populate

我是树视图控件的新手,想填充我的TreeView(两列),标题列为父节点,子标题为子节点,如下所示:

tree view

我已经开始使用以下代码,但我坚持使用它:

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

1 个答案:

答案 0 :(得分:0)

感谢您根据我的知识介绍TreeView!在article的帮助下,我得到了你的条件。

设计视图|执行用户形式:
Design Running_expanded

代码(更新为容纳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