树形目录控件——TreeView控件介绍

[示例六] 控件综合使用示例(1)
本例根据puremis.net中的代码整理。
在工作表中选择菜单“视图”——“工具栏”——“控件工具箱”，使用“图像”控件添加10个图像控件，分别命名为Image1至Image9，还有一个为None。在这些控件中单击右键，选择“属性”并从picture属性中选择合适的图像。然后，将对象名称放置在C1至C11单元格中。在B2至B11单元格，放置名字和相应的父亲的名字，在D列，放置个人简介。此时，工作表Sheet1如图16所示。
 
图16：工作表中的数据
在VBE编辑器中插入一个用户窗体，在其上放置一个TreeView控件和两个文字框控件，并进行相应的设置，如图17所示。
 
图17：设计界面。
TreeView包含TreeNodes的集合，每个TreeNode对象都是TreeNode集合的一个成员，其编号按显示顺序从0到Nodes.Count-1。本例中，没有使用索引号，而是关键字，如：
TreeView1.Nodes.Add(Relative:="The key of Parent", Relationship:=tvwChild, Text:="Your Text")。
在VBE编辑器中插入一个模块，并输入下面的代码：
Option Explicit

Sub MakeFamilyTree()
    Dim arrName As Variant
    Dim arrParent As Variant
    Dim arrMatrix() As Variant
    Dim arrTemp As Variant
    Dim elm As Variant
    Dim i As Long, j As Long
    Dim ret As Variant
    Dim node As node
    Dim bExists As Boolean

    '重置TreeView控件
    UserForm1.TreeView1.Nodes.Clear
   
    '从工作表中获取数据作为一个数组
    With Sheets("Sheet1").Range(Sheets("Sheet1").[A2], Sheets("Sheet1").[A65536].End(xlUp))
        arrName = .Value
        arrParent = .Offset(, 1).Value
    End With
   
    '排序
    ReDim arrMatrix(1 To UBound(arrName), 1 To 1)
    For Each elm In arrParent
        i = i + 1
        ret = Application.Match(elm, arrName, 0)
        If IsError(ret) Then
            arrMatrix(i, 1) = arrName(i, 1)
        Else
            j = 3
            ReDim Preserve arrMatrix(1 To UBound(arrMatrix), 1 To j)
            arrMatrix(i, 1) = arrName(i, 1)
            arrMatrix(i, 2) = elm
            arrMatrix(i, 3) = arrParent(ret, 1)
            Do
                ret = Application.Match(arrParent(ret, 1), arrName, 0)
                If IsError(ret) Then Exit Do
                If arrParent(ret, 1) = "" Then Exit Do
                j = j + 1
                ReDim Preserve arrMatrix(1 To UBound(arrMatrix), 1 To j)
                arrMatrix(i, j) = arrParent(ret, 1)
            Loop
        End If
    Next
    arrTemp = CustomTranspose(arrMatrix)
   
    '添加数据到节点中
    For i = 1 To UBound(arrTemp)
        For j = 1 To UBound(arrTemp, 2)
            If Not IsEmpty(arrTemp(i, j)) Then
                With UserForm1.TreeView1
                    bExists = False
                    For Each elm In .Nodes
                        If elm = arrTemp(i, j) Then bExists = True
                    Next
                    If Not bExists Then
                        If j = 1 Then
                            Set node = .Nodes.Add(, , arrTemp(i, j), arrTemp(i, j), _
                            Image:=GetInfo(arrTemp(i, j), True))
                        Else
                            Set node = .Nodes.Add(arrTemp(i, j - 1), tvwChild, arrTemp(i, j), arrTemp(i, j), _
                            Image:=GetInfo(arrTemp(i, j), True))
                        End If
                        node.Expanded = True
                    End If
                End With
            End If
        Next
    Next
End Sub

Function CustomTranspose(ByVal buf As Variant) As Variant
'转换数组顺序从父节点到子节点
    Dim arrTemp() As Variant
    Dim i As Long, j As Long, k As Long
    ReDim arrTemp(LBound(buf) To UBound(buf), LBound(buf, 2) To UBound(buf, 2))
    For i = 1 To UBound(buf)
        k = 0
        For j = UBound(buf, 2) To 1 Step -1
            If Not IsEmpty(buf(i, j)) Then
                k = k + 1
                arrTemp(i, k) = buf(i, j)
            End If
        Next
    Next
    CustomTranspose = arrTemp
End Function

Function GetInfo(sName, bAorD) As String
'返回合适的图像
    Dim rFound As Range
    Set rFound = Sheet1.Columns(1).Find(sName, lookat:=xlWhole)
    If rFound Is Nothing Then
        GetInfo = "none"
    Else
        GetInfo = IIf(bAorD, rFound.Offset(, 2).Value, rFound.Offset(, 3).Value)
    End If
End Function
在用户窗体代码模块中，输入下面的代码：
Private Sub UserForm_Activate()
    SettingImageList
    MakeFamilyTree
End Sub

Private Sub SettingImageList()
    Dim myImgList As New ImageList
    Dim bt
    With myImgList.ListImages
        .Add Key:="Image1", Picture:=Sheet1.Image1.Picture
        .Add Key:="Image2", Picture:=Sheet1.Image2.Picture
        .Add Key:="Image3", Picture:=Sheet1.Image3.Picture
        .Add Key:="Image4", Picture:=Sheet1.Image4.Picture
        .Add Key:="Image5", Picture:=Sheet1.Image5.Picture
        .Add Key:="Image6", Picture:=Sheet1.Image6.Picture
        .Add Key:="Image7", Picture:=Sheet1.Image7.Picture
        .Add Key:="Image8", Picture:=Sheet1.Image8.Picture
        .Add Key:="Image9", Picture:=Sheet1.Image9.Picture
        .Add Key:="none", Picture:=Sheet1.none.Picture
    End With
    With TreeView1
        Set .ImageList = myImgList
        .Indentation = 14
        .LabelEdit = tvwManual
        .HideSelection = False
    End With
End Sub

Private Sub TreeView1_NodeClick(ByVal node As MSComctlLib.node)
    Me.TextBox1.Text = node.Text
    Me.TextBox2.Text = GetInfo(node.Text, False)
End Sub
运行后的结果如图18所示。
 
图18：运行后的结果

【声明】:以上文章或资料除注明为Office吧自创或编辑整理外，均为各方收集或网友推荐所得。其中摘录的内容以共享、研究为目的，不存在任何商业考虑。如有任何异议，请与本站联系，联系邮箱：thinkou@126.com，本站确认后将立即撤下。谢谢您的支持与理解！

我要评论

查看所有评论内容

评论内容