Access: построение дерева разделов - TreeView и VBA

Дано: База данных Access 2016 с таблицей, где перечислены разделы (подразделения или другие данные, которые можно представить в виде иерархии).
Задача: на Access-форме построить иерархическое дерево на базе указанной выше таблице.


Скачать пример базы в формате Access

Допустим имеется таблица подразделений вуза (tblDepartment) в формате:
intID - strDepartmentName - intParentID
Где,
intID - идентификатор подразделения,
strDepartmentName  - наименование подразделения,
intParentID - идентификатор родительского подразделения.

Корневой элемент будет ссылаться в качестве "родителя" на самого себя.
Также для удобства в конструкторе таблицы в поле родителя можно задать подстановку, ссылаясь на эту же таблицу:




Текст запроса для подстановки:
SELECT tblDepartment.strDepartmentName AS Подразделение,
tblDepartment_1.strDepartmentName AS Родитель,
tblDepartment.intID
FROM tblDepartment LEFT JOIN tblDepartment AS tblDepartment_1
ON tblDepartment.intParentID = tblDepartment_1.intID
ORDER BY tblDepartment.strDepartmentName;


После этого в колонке родителя мы сможем выбирать не идентификатору, а по имени подразделения (но в колонке будет по-прежнему храниться идентификатор).

В итоге мы сможем заполнять таблицу следующим образом:


Теперь построим дерево. Для этого создаем пустую форму в режиме конструктора и выберем пункт "Элементы ActiveX":


В списке выбираем элемент "Microsoft TreeView Control (6.0)"


Выбранный элемент добавляем на форму в нужном месте нужного размера:


Далее переходим в режим кода Visual Basic и добавляем следующий код:

Option Compare Database

Private Sub Form_Load()
Dim strRoot
strRoot = ""
Dim rsCommon As ADODB.Recordset
Set rsCommon = New ADODB.Recordset
rsCommon.Open "SELECT DP.intID, DP.intParentID, DP.strDepartmentName FROM tblDepartment DP WHERE DP.intID = DP.intParentID ORDER BY DP.strDepartmentName", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
If Not rsCommon.EOF Then TreeViewDep.Nodes.Add , , Str(rsCommon("intID")) & "$KEY", rsCommon("strDepartmentName")
strRoot = Str(rsCommon("intID"))
rsCommon.Close
Set rsCommon = Nothing
TreeViewDep.Nodes.Item(strRoot & "$KEY").Expanded = True
AddNode (strRoot)
End Sub

Private Sub AddNode(ByVal ParentID As String)
Set rsCommon = New ADODB.Recordset
rsCommon.Open "SELECT DP.intID, DP.intParentID, DP.strDepartmentName FROM tblDepartment DP WHERE DP.intID <> DP.intParentID AND DP.intParentID = " & ParentID & " ORDER BY DP.strDepartmentName", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
Do While Not rsCommon.EOF
    TreeViewDep.Nodes.Add ParentID & "$KEY", tvwChild, Str(rsCommon("intID")) & "$KEY", rsCommon("strDepartmentName")
    TreeViewDep.Nodes.Item(Str(rsCommon("intID")) & "$KEY").Expanded = True
    AddNode (Str(rsCommon("intID")))
    rsCommon.MoveNext
Loop
rsCommon.Close
Set rsCommon = Nothing
End Sub


Сохраняем код и форму. Теперь можно запускать форму в режиме просмотра. Должно отобразиться дерево:


Если возникает ошибка: User-defined type not defined (на строке кода ADODB.Recordset), то в VBA в меню Tools - References нужно добавить компонент Microsoft ActiveX Data Objects:


И после этого сделать компиляцию - Debug - Compile.

Как вариант можно использовать таблицу, расположенную в базе на MS SQL Server. Для этого достаточно создать связь с таблицами. Все остальные действия по построению дерева будет аналогичны. В этом случае также возможен обход дерева на стороне MS SQL Server.

(с) Ella S.
Если Вам понравилась статья, пожалуйста, поставьте лайк, сделайте репост или оставьте комментарий. Если у Вас есть какие-либо замечания, также пишите комментарии.

5 комментариев :

  1. Этот комментарий был удален автором.

    ОтветитьУдалить
  2. Чтобы работало с node, где родители null

    Option Compare Database

    Private Sub Form_Load()
    Dim strRoot
    strRoot = ""

    AddNode (strRoot)

    End Sub

    Private Sub AddNode(ByVal ParentID As String)
    Set rsCommon = New ADODB.Recordset

    If ParentID = "" Then
    rsCommon.Open "SELECT Êîä, Ðîäèòåëü, Èìÿ FROM Req DP WHERE IsNull(Ðîäèòåëü)" & " ORDER BY Èìÿ", CurrentProject.Connection, adOpenKeyset, adLockOptimistic

    Do While Not rsCommon.EOF
    TreeViewDep.Nodes.Add , , Str(rsCommon("Êîä")) & "$KEY", rsCommon("Èìÿ")
    TreeViewDep.Nodes.Item(Str(rsCommon("Êîä")) & "$KEY").Expanded = True
    AddNode (Str(rsCommon("Êîä")))
    rsCommon.MoveNext
    Loop
    rsCommon.Close
    Set rsCommon = Nothing

    Else
    rsCommon.Open "SELECT Êîä, Ðîäèòåëü, Èìÿ FROM Req DP WHERE Êîä <> Ðîäèòåëü AND Ðîäèòåëü = " & ParentID & " ORDER BY Èìÿ", CurrentProject.Connection, adOpenKeyset, adLockOptimistic

    Do While Not rsCommon.EOF
    TreeViewDep.Nodes.Add ParentID & "$KEY", tvwChild, Str(rsCommon("Êîä")) & "$KEY", rsCommon("Èìÿ")
    TreeViewDep.Nodes.Item(Str(rsCommon("Êîä")) & "$KEY").Expanded = True
    AddNode (Str(rsCommon("Êîä")))
    rsCommon.MoveNext
    Loop
    rsCommon.Close
    Set rsCommon = Nothing
    End If

    End Sub

    ОтветитьУдалить
  3. Здравствуйте. Дорос уже до наполнения дерева по частям. Т.к. элементов несколько тысяч, то построение дерева занимает ощутимое время. Теперь я подгружаю ветку по клику на элемент. Вопрос: как вывести возле элемента значок "+" ? А то неудобно - пока не кликнул, не знаешь есть у этого элемента дочерние позиции или нет

    ОтветитьУдалить
    Ответы
    1. Давно не работала с этим контролом. Может как вариант выводить у каждого элемента в скобках количество дочерних элементов? Или подгружать до клика на элементе хотя бы один его дочерний элемент?

      Удалить
    2. Спасибо за совет. Сейчас эту проблему так и решаю, подгружая дочерние элементы. Но это не совсем удобно, учитывая рекурсивный характер нумерации элементов, который у меня используется. Хотел немного облегчить себе жизнь.

      Удалить