Hi Steve,
I have 2 versions -- the first hardcodes formnames to swap in the code.
The second uses a table (usys_tabs: the usys prefix makes it a
"system" object) to store the swapping information
The "command buttons" (put in quotes because I actually used label
controls) to switch subforms are colored so that you can see which one
is active
The NAME property for the labels to switch are (ie
Tab1
Tab2
Tab3
etc
'~~~~~~~~~~~~~~~~~~~~~~~~
Private Function SwitchTabs(pIndex As Integer)
On Error GoTo SwitchTabs_error
'9 is Notes -- no code, not launched
'crystal
'strive4peace2006 at yahoo.com
Me.TabNumber = pIndex
Dim mNumTabs As Integer, i As Integer, mboo As Boolean
Dim Fore1 As Long, Fore2 As Long, Back1 As Long, Back2 As Long
Fore1 = 16777215
Back1 = 11220286
Fore2 = 8388608
Back2 = 16644084
mNumTabs = 14
For i = 1 To mNumTabs
If pIndex = i Then
Me("tab" & i).BackColor = Back1
Me("tab" & i).ForeColor = Fore1
Else
Me("tab" & i).BackColor = Back2
Me("tab" & i).ForeColor = Fore2
End If
Next i
Select Case pIndex
Case 1, 2, 3, 4, 5, 14
Me.TabSubform.Visible = True
Me.TabSubform.SetFocus
End Select
Select Case pIndex
Case 1
Me.TabSubform.SourceObject = "Address_Sub"
Case 2
Me.TabSubform.SourceObject = "Phone_Sub"
Case 3:
Me.TabSubform.SourceObject = "eAddresses_Sub"
Case 4:
Me.TabSubform.SourceObject = "Websites_sub"
Case 5:
Me.TabSubform.SourceObject = "Products_sub"
Case 14:
Me.TabSubform.SourceObject = "FindPeople_sub"
Case Else
Me.TabSubform.SourceObject = ""
Me.Name1.SetFocus
Me.TabSubform.Visible = False
End Select
Proc_Exit:
Exit Function
Proc_Err:
MsgBox Err.Description, , "ERROR " & Err.Number & " SwitchTabs"
'press F8 to step through lines of code to see where problem is
'comment next line after debugged
Stop : Resume
resume Proc_Exit
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~
TabID is an unbound control -- it is set when the form loads
an example of the Onclick event for the Tab2 label is
=SwitchTabs(2)
I like this much better and it is prettier too!
Sometimes, the subforms do not have linking fields, like a lookup subform
In those cases, I define a calculated control on the subform and set it
equal to the specified control on the main form for LinkMasterFields
(since the number of controls in LinkMasterFields and LinkChildFields
cannot be changed at runtime)
ie, in this example, I have set up an AddressBook application with PID
(people ID) as the main key as the first form to do switching. The
second form to do switching (below) is an Admin form to import and
export information.
unbound subform :
textbox control
name --> PID
ControlSource --> =forms!AddressBook!PID
visible --> no
and now I am taking this one step further:
table --> usys_Tabs
frmID TabID btnCaption frmName IsActive IsSib
1 0 Find FindPeople_sub Yes Yes
1 1 Address Address_Sub Yes Yes
1 2 Phone Phone_Sub Yes Yes
1 3 Email eAddresses_Sub Yes
2 1 Export Admin_Export Yes Yes
2 2 Import Admin_Import Yes Yes
2 3 Import Brio Admin_Import_Brio Yes Yes
2 4 Reports REPORTMENU_A Yes No
2 5 Utilities Admin_Utilities Yes Yes
'~~~~~~~~~~~~~~~~~~~~~~~~
Private Function SwitchTabs(pTabID As Integer)
On Error GoTo Proc_err
Dim mCurrentTab As Integer, i As Integer, mBoo As Boolean
Dim mform As String
Dim Fore1 As Long, Fore2 As Long, Back1 As Long, Back2 As Long
Dim mLastTab As Long
Dim BackNotSub As Long
Dim r As dao.Recordset, S As String
'crystal
'strive4peace2006 at yahoo.com
'needs reference to:
'Microsoft DAO Library
mLastTab = 5
BackNotSub = 16112075
' If Me.Dirty Then Me.Dirty = False
mCurrentTab = Nz(Me.TabID)
Me.TabID = pTabID
'since I have this code behind the form it applies to
'the formID is hardcoded
S = "SELECT Tab.TabID, Tab.btnCaption, " _
& " Tab.frmName, Tab.IsActive, Tab.IsSub " _
& " FROM usys_Tabs AS Tab " _
& " WHERE frmID=2 ORDER BY TabID;"
'don't need to modify record, just look them up
'that is why we use dbOpenSnapshot
Set r = CurrentDb.OpenRecordset(S, dbOpenSnapshot)
r.MoveLast
r.MoveFirst
r.FindFirst "TabID = " & pTabID
Me.dummy.SetFocus
If (r.NoMatch) Or IIf(r.NoMatch, False, Not r!IsActive) Then
MsgBox Nz(r!btnCaption) & " is not active", , _
"Under construction"
Else
If r!IsSub Then
Me.TabSubform.SourceObject = r!FrmName
Fore1 = 16777215
Back1 = 11220286
Fore2 = 8388608
Back2 = 16644084
For i = 1 To mLastTab
If i <> 4 Then
If pTabID = i Then
Me("tab" & i).BackColor = Back1
Me("tab" & i).ForeColor = Fore1
Else
Me("tab" & i).BackColor = Back2
Me("tab" & i).ForeColor = Fore2
End If
End If
Next i
Me.TabSubform.SetFocus
Else
On Error Resume Next
DoCmd.OpenForm r!FrmName
End If
End If
Proc_exit:
On Error Resume Next
r.Close
Set r = Nothing
Exit Function
Proc_err:
MsgBox Err.Description, , "ERROR " & Err.Number & " SwitchTabs"
'press F8 to step through lines of code to see where problem is
'comment next line after code is debugged
Stop: Resume
Resume Proc_exit
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~
Warm Regards,
Crystal
*
have an awesome day
*
MVP Access
Remote programming and Training
strive4peace2006 at yahoo.com
*