Option Compare Database
Option Explicit
Private Const Q As String * 1 = """"
Private Const mconMainForm As String = "Frm_Switchboard_Main"
Private mstrFormArgs As String
Public Property Get FormArgs() As String
FormArgs = mstrFormArgs
End Property
Private Sub Form_Open(Cancel As Integer)
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strKey As String
mstrFormArgs = ""
Set db = CurrentDb
Set rs = db.OpenRecordset( _
"SELECT * " & _
"FROM tbl_Switchboard " & _
"ORDER BY tbl_Switchboard.SB_Parent, tbl_Switchboard.SB_Order", dbOpenSnapshot, dbReadOnly Or dbForwardOnly)
tvSB.nodes.Clear
With rs
While Not .EOF
strKey = !SB_ID & ";" & Nz(!SB_ObjectType) & ";" & Nz(!SB_ObjectName) & ";" & Nz(!SB_Additional)
If !SB_Parent > 0 Then
tvSB.nodes.Add getNodeIndex(!SB_Parent), tvwChild, strKey, !SB_NodeTitle
Else
tvSB.nodes.Add , tvwLast, strKey, !SB_NodeTitle
End If
.MoveNext
Wend
End With
Set rs = Nothing
Set db = Nothing
Me!Switchboard_Subform.SourceObject = mconMainForm
DoCmd.Maximize
End Sub
Private Sub Form_Resize()
On Error Resume Next
Const conBorderDistance As Integer = 100
Const conTV_Width = 3000
Const conTV_HeightDeviation As Integer = -5
Painting = False
With tvSB
.Left = 0
.Top = 0
.Height = 0
.Width = 0
End With
With Switchboard_Subform
.Left = 0
.Top = 0
.Height = 0
.Width = 0
End With
Me.Section(acDetail).Height = Me.InsideHeight _
- Me.Section(acFooter).Height - Me.Section(acHeader).Height
With tvSB
.Left = conBorderDistance
.Width = conTV_Width
.Top = conBorderDistance
.Height = Me.Section(acDetail).Height - conBorderDistance * 2
End With
With Switchboard_Subform
.Left = tvSB.Left + tvSB.Width + conBorderDistance
.Width = InsideWidth - tvSB.Width - conBorderDistance * 3
.Top = conBorderDistance
.Height = tvSB.Height + conTV_HeightDeviation
End With
Painting = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
DoCmd.Restore
DoCmd.SelectObject acForm, Me.Name, True
End Sub
Private Function getNodeIndex(ByVal strKey As String) As Integer
Dim intCounter As Integer
getNodeIndex = 0
For intCounter = 1 To tvSB.nodes.Count
If Split(tvSB.nodes(intCounter).Key, ";")(0) = strKey Then
getNodeIndex = intCounter
Exit For
End If
Next intCounter
End Function
Private Sub tvSB_NodeClick(ByVal node As Object)
Dim strSwitchboard_SubForm_ToShow As String
Dim strForm_OpenArgs As String
strSwitchboard_SubForm_ToShow = mconMainForm
mstrFormArgs = ""
If UBound(Split(node.Key, ";")) = 3 Then
Dim strObjectType As String
Dim strObjectName As String
Dim strObjectAddtnl As String
strObjectType = Split(node.Key, ";")(1)
strObjectName = Split(node.Key, ";")(2)
strObjectAddtnl = Split(node.Key, ";")(3)
On Error Resume Next
Select Case strObjectType
Case "Form"
strSwitchboard_SubForm_ToShow = strObjectName
mstrFormArgs = strObjectAddtnl
Case "Form_Dialog"
DoCmd.OpenForm FormName:=strObjectName, windowmode:=acDialog, OpenArgs:=strObjectAddtnl
Case "Report"
DoCmd.OpenReport reportname:=strObjectName
Case "Code"
CallByName CodeContextObject, strObjectName, VbMethod, strObjectAddtnl
Case ""
Case Else
MsgBox "Unknown Object-Type within Switchboard-table: " & strObjectType, vbExclamation, "Error"
End Select
End If
If Me!Switchboard_Subform.SourceObject <> strSwitchboard_SubForm_ToShow Then
Me!Switchboard_Subform.SourceObject = strSwitchboard_SubForm_ToShow
End If
If Err.Number <> 0 Then
MsgBox "This would result in a " & strObjectType & " called " & Q & strObjectName & Q & " being called," & vbCrLf & _
"but calling the object raised an exception (that object probably just doesn't exist).", _
vbInformation, "Error/bug: (Node-click)"
End If
If strSwitchboard_SubForm_ToShow <> mconMainForm Then
Err.Clear
Switchboard_Subform.Form.RefreshInfo
End If
End Sub
Public Function ShowMessagebox(ByVal strMessageTitle_Suffix As String)
MsgBox "This is a messagebox being raised by a call issued from a switchboard-node", _
vbInformation, "Switchboard Sample Database: " & strMessageTitle_Suffix
End Function