'===========================================================================================
'@Description: this sub adds the first level of nodes. the 'roots'
'@Author: Paul Demchuk
'@Date: April 23, 2009
'@common variables: a) i is the variable used to keep track of current node's key numbers
' b) j is the variable used to obtain the parent's key
' c) rst is the recordset containing the data
'@common loops: The do loops loop through the recordset and if the data is
' in the field which is being added, it will add it
' and i will be keeping track of the parent's key
' when an item is added to the tree, then the j value is incremented
' so that as you go down the tree in each level, the values of
' keys are increasing by 1
'============================================================================================
Sub addRoots()
Dim rst As DAO.Recordset
Dim i As Integer
Set rst = CurrentDb.TableDefs!sampleSheet.OpenRecordset
rst.MoveFirst
i = 0
Do Until rst.EOF
If (rst!partNum <> Empty) Then
TreeView.Nodes.Add Text:=rst!partNum, Key:="prt=" & i
i = i + 1
End If
rst.MoveNext
Loop
End Sub
'==============================================================================
'@Description: this sub adds the first level of children
'@Author: Paul Demchuk
'@Date: April 23, 2009
'==============================================================================
Sub addChildren()
Dim rst As DAO.Recordset
Dim i As Integer
Dim j As Integer
Set rst = CurrentDb.TableDefs!sampleSheet.OpenRecordset
i = -1
j = 0
rst.MoveFirst
Do Until rst.EOF
If (rst!tier <> Empty) Then '
TreeView.Nodes.Add relationShip:=tvwChild, Relative:="prt=" & i, _
Text:=rst!tier, Key:="t1=" & j
j = j + 1
ElseIf (rst!partNum <> Empty) Then
i = i + 1
End If
rst.MoveNext
Loop
End Sub
'==============================================================================
'@Description: this sub adds the next level of children
'@Author: Paul Demchuk
'@Date: April 23, 2009
'==============================================================================
Sub addChildren2()
Dim rst As DAO.Recordset
Dim i As Integer
Dim j As Integer
Set rst = CurrentDb.TableDefs!sampleSheet.OpenRecordset
i = -1
j = 0
rst.MoveFirst
Do Until rst.EOF
If (rst!tier2 <> Empty) Then
TreeView.Nodes.Add relationShip:=tvwChild, Relative:="t1=" & i, _
Text:=rst!tier2, Key:="t2=" & j
j = j + 1
ElseIf (rst!tier <> Empty) Then
i = i + 1
End If
rst.MoveNext
Loop
End Sub
'==============================================================================
'@Description: this sub adds the next level of children
'@Author: Paul Demchuk
'@Date: April 23, 2009
'==============================================================================
Sub addChildren3()
Dim rst As DAO.Recordset
Dim i As Integer
Dim j As Integer
Set rst = CurrentDb.TableDefs!sampleSheet.OpenRecordset
i = -1
j = 0
rst.MoveFirst
Do Until rst.EOF
If (rst!tier3 <> Empty) Then
TreeView.Nodes.Add relationShip:=tvwChild, Relative:="t2=" & i, _
Text:=rst!tier3, Key:="t3=" & j
j = j + 1
ElseIf (rst!tier2 <> Empty) Then
i = i + 1
End If
rst.MoveNext
Loop
End Sub
'==============================================================================
'@Description: this sub adds the next level of children
'@Author: Paul Demchuk
'@Date: April 23, 2009
'==============================================================================
Sub addChildren4()
Dim rst As DAO.Recordset
Dim i As Integer
Dim j As Integer
Set rst = CurrentDb.TableDefs!sampleSheet.OpenRecordset
i = -1
j = 0
rst.MoveFirst
Do Until rst.EOF
If (rst!tier4 <> Empty) Then
TreeView.Nodes.Add relationShip:=tvwChild, Relative:="t3=" & i, _
Text:=rst!tier4, Key:="t4=" & j
j = j + 1
ElseIf (rst!tier3 <> Empty) Then
i = i + 1
End If
rst.MoveNext
Loop
End Sub
'==============================================================================
'@Description: this sub calls all the other subs to populate the tree
'@Author: Paul Demchuk
'@Date: April 23, 2009
'==============================================================================
Private Sub Form_Open(Cancel As Integer)
SetupTreeview
addRoots
addChildren
addChildren2
addChildren3
addChildren4
End Sub
'==============================================================================
'@Description: this sub gives the tree all it's settings
'@Author: Paul Demchuk
'@Date: April 23, 2009
'==============================================================================
Private Sub SetupTreeview()
With Me.TreeView
.Style = tvwTreelinesPlusMinusText
.LineStyle = tvwRootLines
.Indentation = 240
.Appearance = ccFlat
.HideSelection = False
.BorderStyle = ccFixedSingle
.HotTracking = True
.FullRowSelect = True
.Checkboxes = True
.SingleSel = False
.Sorted = False
.Scroll = True
.LabelEdit = tvwManual
.Font.Name = "Verdana"
.Font.Size = 7
End With
End Sub
'==============================================================================
'@Description: this sub makes wonderful things happen when nodes are clicked
'@Author: Paul Demchuk
'@Date: April 23, 2009
'==============================================================================
Private Sub TreeView_Click()
Dim rst As DAO.Recordset
Dim nodSelected As MSComctlLib.Node ' a variable for the currently selected node
Dim nodeText As String
Dim num As String
Dim counter As Integer
Dim check As Boolean
Dim display As String
Set rst = CurrentDb.TableDefs!sampleSheet.OpenRecordset
Set nodSelected = Me.TreeView.SelectedItem ' get the currently selected node
check = False
nodeText = findRoot(nodSelected).Text
num = Mid(nodSelected.Key, 4)
rst.MoveFirst
If (nodSelected.Key Like "t1=*") Then
If (num <> 0) Then
Do Until rst.EOF Or check = True
If (rst!tier <> 0) Then
counter = counter + 1
End If
If (counter = num) Then
check = True
Else
rst.MoveNext
End If
Loop
Else
Do Until rst!tier <> Empty
rst.MoveNext
Loop
End If
display = rst!Data
ElseIf (nodSelected.Key Like "t2=*") Then
If (num <> 0) Then
Do Until rst.EOF Or check = True
If (rst!tier2 <> 0) Then
counter = counter + 1
End If
If (counter = num) Then
check = True
Else
rst.MoveNext
End If
Loop
Else
Do Until rst!tier2 <> Empty
rst.MoveNext
Loop
End I
display = rst!Data
End If
Text = Text & display & vbCrLf
End Sub
'==============================================================================
'@Description: this sub finds the ROOT node of any given node parameter
'@Author: Paul Demchuk
'@Date: April 23, 2009
'==============================================================================
Private Function findRoot(n As MSComctlLib.Node) As MSComctlLib.Node
Dim root As MSComctlLib.Node
Dim check As Boolean
Set root = n
check = True
If (root.Key Like "prt=*" = False) Then
While check = True
Set root = root.parent
If (root.Key Like "prt=*") Then
check = False
End If
Wend
End If
Set findRoot = root
End Function
, ive only been using VB for like 4 days or so...so Im just learnin!)
