与列标题和子头

Question

我是新来的树视图控件，并愿与标题列的父节点和子头作为子节点来填充我的TreeView（两列）填充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