创建树状目录结构

标签：VBA，用户窗体，TreeView控件

我们都知道，使用TreeView控件可以创建树状目录结构，但如何创建，还是有些技巧，这就是本文要介绍的内容。

如图1所示，使用TreeView创建了树状目录结构。

图1

细心的朋友可能注意到，这个目录是根据工作表中的内容结构创建的。只要我们按一定的规则在工作表中输入数据，代码就会根据这些数据创建出相应的分层目录结构。

如下图2所示，在VBE中插入一个用户窗体，然后布置相应的TreeView控件和按钮控件。

图2

在该用户窗体代码模块中，输入下列代码：

代码语言：javascript复制

Option Explicit

Private Sub CommandButton1_Click()
 Dim intCount As Integer, strNodes As String, lngSelCount As Long
 lngSelCount = 0
 
 If TreeView1.SelectedItem Is Nothing Then
 
 Else
   With TreeView1.SelectedItem
     strNodes = "索引: " & .Index & Chr(13) & "单元格区域: " & .Key & Chr(13) & "任务: " & .text
   End With
   MsgBox Chr(13) & strNodes & Chr(13), , "已选取任务"
 End If
End Sub

Private Sub CommandButton2_Click() 
  Unload UserForm1
End Sub

Private Sub CommandButton3_Click()
  With TreeView1
    .Nodes.Clear
  End With
End Sub

Private Sub CommandButton4_Click()
  Dim nPnode As Node
  Dim cRng As Range
  Const cRoot As String = "$B$4"
 
  With TreeView1
    .Nodes.Clear
    Set nPnode = .Nodes.Add(, ,Range(cRoot).Address, Sheet1.Range(cRoot).Value)
    nPnode.Expanded = True
    For Each cRng In Sheet1.Range(cRoot).CurrentRegion
      If cRng.Value <> vbNullString And cRng.Address <> cRoot Then
        Set nPnode = .Nodes(cRng.Offset(, -1).End(xlUp).Address)
        If nPnode Is Nothing Then
          MsgBox "错误: 父节点" & cRng.Offset(, -1).End(xlUp).Value & " 没有找到...", vbExclamation, "错误"
          Exit Sub
        End If
      .Nodes.Add nPnode, tvwChild, cRng.Address, cRng.Value
      If Err.Number <> 0 Then
        MsgBox "错误: 节点" & cRng.Value & "重复. 所有节点描述必须唯一", vbExclamation, "错误"
        Exit Sub
      End If
     End If
   Next
   With .Nodes(Range(cRoot).Address)
     .Selected = True
     .EnsureVisible
   End With
   .Style = tvwTreelinesPlusMinusText
 End With
End Sub

Sub A_Unique_B()
  Dim X
  Dim objDict As Object
  Dim lngRow As Long
  Set objDict = CreateObject("Scripting.Dictionary")
  X = Application.Transpose(Range([H1], Cells(Rows.Count, "H").End(xlUp)))
  For lngRow = 1 To UBound(X, 1)
    objDict(X(lngRow)) = 1
  Next
  Range("H1:H" & objDict.Count) = Application.Transpose(objDict.keys)
End Sub

Private Sub UserForm_Initialize()
  Dim nPnode As Node
  Dim cRng As Range
  Const cRoot As String = "$B$4"
 
  With TreeView1
    .Nodes.Clear
    Set nPnode = .Nodes.Add(, , Range(cRoot).Address, Sheet1.Range(cRoot).Value)
    nPnode.Expanded = True
    For Each cRng In Sheet1.Range(cRoot).CurrentRegion
      If cRng.Value <> vbNullString And cRng.Address <> cRoot Then
        Set nPnode = .Nodes(cRng.Offset(, -1).End(xlUp).Address)
        If nPnode Is Nothing Then
          MsgBox "错误: 父节点" & cRng.Offset(, -1).End(xlUp).Value & " 没有找到...", vbExclamation, "错误"
          Exit Sub
        End If
        .Nodes.Add nPnode, tvwChild, cRng.Address, cRng.Value
        If Err.Number <> 0 Then
          MsgBox "错误: 节点" & cRng.Value & " 重复. 所有节点描述必须唯一", vbExclamation, "错误"
          Exit Sub
        End If
      End If
    Next
    With .Nodes(Range(cRoot).Address)
      .Selected = True
      .EnsureVisible
    End With
    .Style = tvwTreelinesPlusMinusText
   End With
 End Sub

注意，这个示例可以作为模板，代码不变，只需修改工作表中的数据就可以创建相应的目录层次结构。

nodes range 工作 数据 索引

1 人点赞