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
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