I had a suggestion to use @MajP's Tree view class to show the structure of my custom ribbon in this old post, which I did at the time.
But, recently because of a change in my tables structure, I had to rebuild the necessary queries for his class. Though the tree itself is showing and I have not any error in the tree itself, but I've lost the possibility of saving the nodes after drag and drop.
To keep everything as simple as possible, I've copied tables and queries to his v18 tree view and have attached it here.
The ribbon items have been changed with a function using random keywords to change them from local language to English, so they are meaningless.
My main question:
I've read his hierarchical and tree view post, but still can't understand how t_E2E table should be filled.
This, causes to a fail in qryNodeE2E and raising 35613 in reLoadE2E procedure.
This demo was asked by @Mike Krailo if using an Acess Treeview could you do some of the functions of the Utility https://itemgenie.com/ He and I have been working together to make this a useable utility and demonstrate a lot of functionality using a Treeview. Some background here...
www.access-programmers.co.uk
When you move something you have to reassign the parent id in code. There is no "bound" tree.
Code:
Private Sub tvw_TreeviewNodeDragDrop(DragPK As Variant, DropPK As Variant, DragNode As MSComctlLib.Node, DropNode As MSComctlLib.Node)
'Demonstrates drag and drop
Dim strSql As String
Dim DragNodeIdentifier
Dim DropNodeIdentifier
Dim DroppedOnRoot As Boolean
DragNodeIdentifier = DragNode.Tag
DropNodeIdentifier = DropNode.Tag
DroppedOnRoot = (DragNode.Key = DropNode.Key)
'If drag node = drop node it is dropped on a root
'Location can only be dropped on other locations not on Items
If DragNodeIdentifier = "Location_" Then
'Make it a root node
If DropNode.Key = DragNode.Key Then
strSql = "Update tblLocations set parent_iD = NULL where Location_ID = " & DragPK
ElseIf DropNodeIdentifier = "Location_" Then
strSql = "Update tblLocations set parent_iD = " & DropPK & " where Location_ID = " & DragPK
ElseIf DropNodeIdentifier = "Item_" Then
Dim parentLocationID As Long
parentLocationID = GetNewParentPK(DropNode.Key)
strSql = "Update tblLocations set parent_iD = " & parentLocationID & " where Location_ID = " & DragPK
MsgBox "You dropped on an Item and not a location. Need to figure out how to handle this, and it may not be easy. So Reloading, and moving it to a location"
reLoadTreeview
End If
'Items can be dropped under Locations but not under other Identifiers
ElseIf DragNodeIdentifier = "Item_" Then
If DropNodeIdentifier = "Location_" Then
strSql = "Update tblItems set Location_iD_FK = " & DropPK & " where Item_ID = " & DragPK
ElseIf DroppedOnRoot Then
strSql = "Update tblItems set Location_iD_FK = Null where Item_ID = " & DragPK
ElseIf DropNodeIdentifier = "Item_" Then
MsgBox "You dropped an item onto an item. This will not persist. You need to move it under a location. It will move it to the drop node's parent.", vbCritical, "Must Put under Location"
Dim ParentLocationKey As String
ParentLocationKey = "Location_" & GetParentPK(tvw.getNodePK(DropNode), "Item_")
tvw.MoveNodeByKey DragNode.Key, ParentLocationKey
End If
End If
If strSql <> "" Then CurrentDb.Execute strSql
End Sub
If you drop a node on to a new "viable" location then you have to do an update query. The drag nodes parent ID becomes the drop node.
Like the above case it gets more complicated. You can only drop your nodes under the appropriate level. You cannot drop a Tab under a control, or group. You cannot drop a ribbon under a control, Etc.
You have to do an if check to determine if the node is dropped under a viable parent node.
Unfortunately you cannot stop the drag and drop. So if it you drop it on an improper level then the above code moves it back to where it came from, forcing you to drop on the appropriate level.
Similarly you can move things around in the tree and have the sort order persist. Then you use the tree to move nodes up and down within a level. This is far easier for sorting then doing it manually.
When the form closes updated the sort order in your tables. Something like this.
Code:
Public Sub UpdateSortAndLevel()
On Error GoTo UpdateSortAndLevel_Error
Dim i As Variant
Dim strSql As String
Dim nd As Node
Dim Identifier As String
Dim Level As Integer
Dim PK As Long
For Each nd In tvw.TreeView.Nodes
i = i + 1
Identifier = tvw.getNodeIdentifier(nd)
Level = tvw.GetNodeLevel(nd)
PK = CLng(tvw.getNodePK(nd))
' Debug.Print "Key " & nd.key & " PK " & PK
If Identifier = "Location_" Then
strSql = "UPDATE tblLocations Set TreeSort = " & i & ", NodeLevel = " & Level & " where Location_ID = " & PK
ElseIf Identifier = "Item_" Then
strSql = "UPDATE tblItems Set TreeSort = " & i & ", NodeLevel = " & Level & " where Item_ID = " & PK
End If
' Debug.Print strSql
If strSql <> "" Then
CurrentDb.Execute strSql, dbFailOnError
End If
Next nd
Reading from top of tree down the first node is 1 the last node gets a sort order of N (where n is number of nodes)
I also recommend you add the NodeLevel field to all of your tables in the tree. This will allow you then to make a pseudo tree display in forms, reports.
Video linked for explanation. I have 7 different HeaderTypes. Which I need to be displayed in a continuous form; similar to grouping on a report. Do not be fooled by the apparent sorted order of the BillTemsF. It appears sorted because correctly because BillHeadersAndItemsT ID has been created...
www.access-programmers.co.uk
The form shown is a standard form using the sort order and level to make it appear as a tree and allow the color formatting.
Private Sub tvw_TreeviewNodeDragDrop(DragPK As Variant, DropPK As Variant, DragNode As MSComctlLib.Node, DropNode As MSComctlLib.Node)
'Demonstrates drag and drop
'Ribbon
'RibbonTab
'RibbonGroup
'RibbonControl
Dim DragNodeIdentifier As String
Dim DropNodeIdentifier As String
Dim NodeText As String
Dim nodekey As String
Dim OriginalParentKey As String
Dim strSql As String
DragNodeIdentifier = tvw.getNodeIdentifier(DragNode)
DropNodeIdentifier = tvw.getNodeIdentifier(DropNode)
'MsgBox DragNodeIdentifier
Select Case DragNodeIdentifier
Case "Ribbon"
If DropNodeIdentifier <> "Ribbon" Then
MsgBox "Cannot drop a ribbon under another node"
'This is harder then other nodes to add to the root must delete and re add the node
nodekey = DragNode.key
NodeText = DragNode.Text
'Delete moved node and move it back by adding new to root.
tvw.Nodes.Remove (DragNode.key)
tvw.Nodes.Add , , nodekey, NodeText
End If
'can only drop a tab under the Ribbon
Case "RibbonTab"
If DropNodeIdentifier <> "Ribbon" Then
MsgBox "Can only drop a Tab under a Ribbon"
'move back to original parent that ID is in the table
OriginalParentKey = GetOriginalParentKey(DragNode.key)
tvw.MoveNodeByKey DragNode.key, OriginalParentKey
Else
'I cannot test it here but if you are going to have multiple ribbons you need to do an update query here
'assign the current RibbonTab RibbonFK to the new RibbonFk
End If
Case "RibbonGroup"
If DropNodeIdentifier <> "RibbonTab" Then
MsgBox "Can only drop a RibbonGroup under a RibbonTab"
'move back to original parent that ID is in the table
OriginalParentKey = GetOriginalParentKey(DragNode.key)
tvw.MoveNodeByKey DragNode.key, OriginalParentKey
Else
'Update to new parent
strSql = "Update tblRibbonGroups Set tabFK = " & DropPK & " Where RibbonGroupsPK = " & DragPK
End If
Case "RibbonControl"
End Select
If strSql <> "" Then CurrentDb.Execute strSql
End Sub
I provided an updated version of the TreeviewForm class that has some new methods. Added a GetPriorParentKey function to help move nodes back to where they came.
If you add the following fields "TreeSort" and "NodeLevel" to each table and include the TreeSort in the Union query then you can sort nodes the way you like them to appear and persist that in the table. No longer do you have to enter the sort order
Code:
Public Sub autolevel()
Dim i As Variant
Dim strSql As String
Dim nd As Node
Dim Identifier As String
Dim Level As Integer
Dim PK As Long
For Each nd In tvw.TreeView.Nodes
i = i + 1
Identifier = tvw.getNodeIdentifier(nd)
Level = tvw.GetNodeLevel(nd)
PK = CLng(tvw.getNodePK(nd))
Select Case Identifier
'Ribbon
'RibbonTab
'RibbonGroup
'RibbonControl
Case "Ribbon"
Case "RibbonTab"
strSql = "UPDATE tblRibbonTabs Set TreeSort = " & i & ", NodeLevel = " & Level & " where RibbonTabsPk = " & PK
Case "RibbonGroup"
Case "RibbonControl"
End Select
If strSql <> "" Then
CurrentDb.Execute strSql, dbFailOnError
End If
Next nd
End Sub
You can try to drop things on the wrong level (you have to finish controls) they will move back to proper level. Groups demos the update to the new parent.
If you want to persist the tree sort order in the tables you have to add the fields and complete this.
Code:
Public Sub autolevel()
Dim i As Variant
Dim strSql As String
Dim nd As Node
Dim Identifier As String
Dim Level As Integer
Dim PK As Long
For Each nd In tvw.TreeView.Nodes
i = i + 1
Identifier = tvw.getNodeIdentifier(nd)
Level = tvw.GetNodeLevel(nd)
PK = CLng(tvw.getNodePK(nd))
Select Case Identifier
'Ribbon
'RibbonTab
'RibbonGroup
'RibbonControl
Case "Ribbon"
Case "RibbonTab"
strSql = "UPDATE tblRibbonTabs Set TreeSort = " & i & ", NodeLevel = " & Level & " where RibbonTabsPk = " & PK
Case "RibbonGroup"
Case "RibbonControl"
End Select
If strSql <> "" Then
CurrentDb.Execute strSql, dbFailOnError
End If
Next nd
End Sub
