Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

TreeView v6.0 Control help needed

Status
Not open for further replies.

thelke

MIS
Apr 9, 2002
84
I have the treeview control, working with the code in the Fabrikam DB that MS made. I want to mimic the switchboard that they have. I have made it work, but would like certain nodes (I believe I am phrasing that correctly) to go to the subMain subform in frm_Switchboard and others to go to the subSelect subform in frm_Switchboard. Here is the code for the TreeView control in Fabrikam, can someoen help me pls? This is a complicated control.

Option Compare Database
Option Explicit

Dim bTreeEnabled As Boolean

Private Sub cmdSaveScratchPad_Click()
'=============================================================
'
' Save the Scratch Pad data
'
'=============================================================
' Parameters
'---------------
'
'=============================================================
On Error GoTo ErrorHandler

DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70

Finally: 'Always call this block of code to clean up objects etc.

Exit Sub

' Error handling block added by VBA Code Commenter and Error Handler Add-In. DO NOT EDIT this block of code.
ErrorHandler: ' Automatic error handler last updated at Thursday, March 22, 2001 6:36:06 PM
Select Case Err
Case Else
HandleGeneralError Err, "Form_frm_Switchboard.cmdSaveScratchPad_Click", ""

End Select
' End Error handling block.
End Sub

Public Sub EnableForm(bEnable As Boolean)
'=============================================================
'
' Enable/Disable the form
'
'=============================================================
' Parameters
'---------------
' bEnable (Boolean)
'=============================================================
On Error GoTo ErrorHandler

bTreeEnabled = bEnable

Finally: 'Always call this block of code to clean up objects etc.

Exit Sub

' Error handling block added by VBA Code Commenter and Error Handler Add-In. DO NOT EDIT this block of code.
ErrorHandler: ' Automatic error handler last updated at Thursday, March 22, 2001 6:36:06 PM
Select Case Err
Case Else
HandleGeneralError Err, "Form_frm_Switchboard.EnableForm", ""

End Select
' End Error handling block.
End Sub

Private Sub Form_Load()
'=============================================================
'
' Initialize the form on load
'
'=============================================================
' Parameters
'---------------
'
'=============================================================
On Error GoTo ErrorHandler

bTreeEnabled = True

'DoCmd.Maximize

BuildTree

InitUser

subScratchpad.Form.Filter = "UserID = '" & objUserDetails.UserName & "'"
subScratchpad.Form.FilterOn = True

If subScratchpad.Form.UserID = "" Or IsNull(subScratchpad.Form.UserID) Then
subScratchpad.Form.UserID = objUserDetails.UserName

End If

Finally: 'Always call this block of code to clean up objects etc.

Exit Sub

' Error handling block added by VBA Code Commenter and Error Handler Add-In. DO NOT EDIT this block of code.
ErrorHandler: ' Automatic error handler last updated at Thursday, March 22, 2001 6:36:06 PM
Select Case Err
Case Else
HandleGeneralError Err, "Form_frm_Switchboard.Form_Load", ""

End Select
' End Error handling block.
End Sub

Sub BuildTree()
'====================================================
'
' Build the tree of unapproved tasks based on the user
' information supplied.
'
' --------------
' Author - MCAN
' Created - 2001/01/03
'====================================================
On Error GoTo ErrorHandler

Dim conPO As ADODB.Connection
Dim rsFormCategories As ADODB.Recordset
Dim rsForms As ADODB.Recordset

Dim strCategoryText As String
Dim strFormText As String
Dim strCategoryKey As String
Dim strFormKey As String

Dim iJobID As Integer
Dim strJobKey As String
Dim strTaskKey As String
Dim strDate As String
Dim strDateKey As String
Dim dblTotalTaskDuration As Double
Dim dblTotalJobDuration As Double
Dim strDurationInHours As String

Set conPO = CurrentProject.Connection

Set rsFormCategories = New ADODB.Recordset

'Open a recordset of data for Purchase orders with outstanding items.
rsFormCategories.Open "select distinct Section from tbl_TreeForms where Application = 'DV' or Application = 'CUST' or Application = 'ADMIN' or Application = 'HR' or Application = 'ACCTG' order by section", conPO, adOpenStatic, adLockReadOnly

If rsFormCategories.RecordCount > 0 Then
Set rsForms = New ADODB.Recordset
Else
GoTo Finally
End If

treForms.Nodes.Clear

'Make sure we are at the first record.
rsFormCategories.MoveFirst

'Step through the recordset building the tree.
Do While Not rsFormCategories.EOF
'Construct the display text and unique key for the top level node.
'Node Keys must begin with a letter not a number
With rsFormCategories
strCategoryText = .Fields("Section").Value
strCategoryKey = .Fields("Section").Value

'Add the top level node for this record.
'And set the total duration for this date to 0
treForms.Nodes.Add , , strCategoryKey, strCategoryText

rsForms.Open "Select Description, FormName from tbl_TreeForms where Section = '" & .Fields("Section").Value & "' and (Application = 'DV' or Application = 'CUST' or Application = 'ADMIN' or Application = 'HR' or Application = 'ACCTG')", conPO, adOpenStatic, adLockReadOnly

End With

Do While Not rsForms.EOF
With rsForms
strFormText = .Fields("Description")
strFormKey = .Fields("FormName").Value

treForms.Nodes.Add strCategoryKey, tvwChild, strFormKey, strFormText
.MoveNext

End With

Loop

rsForms.Close
rsFormCategories.MoveNext

Loop

Finally:
Set conPO = Nothing
Set rsFormCategories = Nothing
Set rsForms = Nothing
Exit Sub

ErrorHandler:
Select Case Err
Case 70 'Progress Component Error
Resume Next

Case 0
Resume

Case Else
HandleGeneralError Err, "BuildTree", Me.Name

End Select

End Sub

Private Sub treForms_NodeClick(ByVal Node As Object)
'=============================================================
'
' When a node of the tree is clicked if it is a form node, a child
' then show the corresponding form in the sub main area unless the
' bTreeEnabled is set to true in which case a form in sub main
' is currently being edited
'
'=============================================================
' Parameters
'---------------
' Node (Object)
'=============================================================
On Error GoTo ErrorHandler

Echo False

If Node.Parent Is Nothing Then
'Do Nothing

Else
If bTreeEnabled Then
subMain.SourceObject = Node.Key

End If

End If

Finally: 'Always call this block of code to clean up objects etc.
Echo True
Exit Sub

' Error handling block added by VBA Code Commenter and Error Handler Add-In. DO NOT EDIT this block of code.
ErrorHandler: ' Automatic error handler last updated at Thursday, March 22, 2001 6:36:06 PM
Select Case Err
Case Else
HandleGeneralError Err, "Form_frm_Switchboard.treForms_NodeClick", ""
GoTo Finally
End Select
' End Error handling block.
End Sub

Public Sub RefreshToDos()
'=============================================================
'
' Refresh the To-Do Sub form
'
'=============================================================
' Parameters
'---------------
'
'=============================================================
On Error GoTo ErrorHandler

subToDos.Form.RefreshForm

Finally: 'Always call this block of code to clean up objects etc.

Exit Sub

' Error handling block added by VBA Code Commenter and Error Handler Add-In. DO NOT EDIT this block of code.
ErrorHandler: ' Automatic error handler last updated at Thursday, March 22, 2001 6:36:06 PM
Select Case Err
Case Else
HandleGeneralError Err, "Form_frm_Switchboard.RefreshToDos", ""

End Select
' End Error handling block.
End Sub

Public Sub RefreshMainForm()
'=============================================================
'
' Refresh the main form
'
'=============================================================
' Parameters
'---------------
'
'=============================================================
On Error Resume Next

subMain.Form.RefreshData

Finally: 'Always call this block of code to clean up objects etc.

Exit Sub

' Error handling block added by VBA Code Commenter and Error Handler Add-In. DO NOT EDIT this block of code.
ErrorHandler: ' Automatic error handler last updated at Thursday, March 22, 2001 6:36:06 PM
Select Case Err
Case Else
HandleGeneralError Err, "Form_frm_Switchboard.RefreshMainForm", ""

End Select
' End Error handling block.
End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top