I thought of that and checked, thats why i mentioned in my last message that
test (the subform) has no form level events.
Below is all the code for the form (testmain) and the subform (test).
Perhaps you will see something I do not. I did not include code from the
module, which is referecned in certain spots.
TESTMAIN
Option Compare Database
Option Explicit
Dim bResize As Boolean
Private Sub AreaFilter_AfterUpdate()
' Set filter for subform
Test.Form.RecordSource = "SELECT * FROM qryTest WHERE Area=" & _
AreaFilter & " ORDER BY Name"
EmployeeFilter = ""
'Don't try to load the form if there are not records for this employee
If Test.Form.Recordset.RecordCount > 0 Then Test_Form_Load Test.Form,
Test.Form.Recordset.Area, Test.Form.Recordset.RecordCount
End Sub
Private Sub cmdReset_Click()
Dim i As Integer
' Reset filters and recordsource
EmployeeFilter = ""
AreaFilter = ""
Test.Form.RecordSource = "SELECT * FROM qryTest WHERE 1=2"
For i = 14 To 32 Step 2
Test.Controls.Item(i).Visible = False
Test.Controls.Item(i).ColumnHidden = True
Next i
' Clear any filters/sorts
' Test.Form.Filter = ""
End Sub
Private Sub cmdView_Click()
' Set the view of the subform to the type shown on the command button
caption
Test.SetFocus
cmdView.Caption = IIf(Test.Form.CurrentView = 1, "Form", "Datasheet")
RunCommand acCmdSubformDatasheet
End Sub
Private Sub EmployeeFilter_AfterUpdate()
Test.Form.RecordSource = "SELECT * FROM qryTest WHERE EmployeeID=" &
EmployeeFilter
AreaFilter = ""
'Don't try to load the form if there are not records for this employee
If Test.Form.Recordset.RecordCount > 0 Then Test_Form_Load Test.Form,
Test.Form.Recordset.Area, Test.Form.Recordset.RecordCount
End Sub
Private Sub Form_Load()
Dim ctrlidx As Integer
Dim i As Integer
Test.Form.RecordSource = "SELECT * from qryTest WHERE 1=2"
' Make sure first few columns are visible. They may have been turned
off in the
' employee form
' Set focus to first visible control on form so other controls may be
changed
' Test.Requery
' Test.Form.Controls("2").SetFocus
Test.Form.LastName.Visible = True
Test.Form.LastName.ColumnHidden = False
Test.Form.Area.Visible = True
Test.Form.Area.ColumnHidden = False
Test.Form.PSLevel.Visible = True
Test.Form.PSLevel.ColumnHidden = False
Test.Form.Hire.Visible = True
Test.Form.Hire.ColumnHidden = False
Test.Form.Schedule.Visible = True
Test.Form.Schedule.ColumnHidden = False
Test.Form.NextTest.Visible = True
Test.Form.NextTest.ColumnHidden = False
Test.Form.NewTargetDate.Visible = True
Test.Form.NewTargetDate.ColumnHidden = False
Test.Form.RecordSelectors = True
' Set all other controls to hidden
' Set other controls to invisible
For i = 14 To 32 Step 2
Test.Controls.Item(i).Visible = False
Test.Controls.Item(i).ColumnHidden = True
Next i
End Sub
Private Sub Form_Resize()
' If bResize Then Exit Sub
' bResize = True
' Don't shrink width less than 11535, since that is needed by the main
form filter.
' Default insidewidth is 11445
' Debug.Print InsideWidth, Width, Test.Width, InsideHeight, Test.Height,
Me.Detail.Height, Time()
On Error Resume Next
If InsideWidth > 10000 Then
Test.Width = Me.InsideWidth - 225
Me.Width = Me.InsideWidth - 45
End If
' Don't allow a invalid height
If Me.InsideHeight > 4125 Or Test.Height > 2985 Then
' This line below is causing a problem
Me.Detail.Height = Me.InsideHeight - 180
Test.Height = Me.InsideHeight - 1140
Me.Detail.Height = Me.InsideHeight - 180
' Test.Height = Me.InsideHeight - 1140
' Detail height can expand by itself, but it doesn't shrink.
Correct that.
' Me.Detail.Height = Me.InsideHeight - 180
End If
' bResize = False
End Sub
' Returns true if database is Read only, otherwise false
Public Function dbReadOnly() As Boolean
Dim fs, f, r
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(CurrentDb.Name)
If f.Attributes And 1 Then
dbReadOnly = True
Else
dbReadOnly = False
End If
End Function
TEST (Subform)
Option Compare Database
Option Explicit
Private Sub Ctl10_AfterUpdate()
UpdateCtrl Ctl10, Parent.EmployeeID
End Sub
Private Sub Ctl10_DblClick(Cancel As Integer)
' Check for BofK
BofK EmployeeID, Me.Controls("10").Tag
End Sub
Private Sub Ctl11_AfterUpdate()
UpdateCtrl Ctl11, Parent.EmployeeID
End Sub
Private Sub Ctl11_DblClick(Cancel As Integer)
' Check for BofK
BofK EmployeeID, Me.Controls("11").Tag
End Sub
Private Sub Ctl2_AfterUpdate()
UpdateCtrl Ctl2, Parent.EmployeeID
End Sub
Private Sub Ctl2_DblClick(Cancel As Integer)
' Check for BofK
BofK EmployeeID, Me.Controls("2").Tag
End Sub
Private Sub Ctl3_AfterUpdate()
UpdateCtrl Ctl3, Parent.EmployeeID
'Check if update was wanted. If an empty string then ask about a delete
End Sub
Private Sub Ctl3_DblClick(Cancel As Integer)
' Check for BofK
BofK EmployeeID, Me.Controls("3").Tag
End Sub
Private Sub Ctl4_AfterUpdate()
UpdateCtrl Ctl4, Parent.EmployeeID
End Sub
Private Sub Ctl4_DblClick(Cancel As Integer)
' Check for BofK
BofK EmployeeID, Me.Controls("4").Tag
End Sub
Private Sub Ctl5_AfterUpdate()
UpdateCtrl Ctl5, Parent.EmployeeID
End Sub
Private Sub Ctl5_DblClick(Cancel As Integer)
' Check for BofK
BofK EmployeeID, Me.Controls("5").Tag
End Sub
Private Sub Ctl6_AfterUpdate()
UpdateCtrl Ctl6, Parent.EmployeeID
End Sub
Private Sub Ctl6_DblClick(Cancel As Integer)
' Check for BofK
BofK EmployeeID, Me.Controls("6").Tag
End Sub
Private Sub Ctl7_AfterUpdate()
UpdateCtrl Ctl7, Parent.EmployeeID
End Sub
Private Sub Ctl7_DblClick(Cancel As Integer)
' Check for BofK
BofK Me.EmployeeID, Me.Controls("7").Tag
End Sub
Private Sub Ctl8_AfterUpdate()
UpdateCtrl Ctl8, Parent.EmployeeID
End Sub
Private Sub Ctl8_DblClick(Cancel As Integer)
' Check for BofK
BofK EmployeeID, Me.Controls("8").Tag
End Sub
Private Sub Ctl9_AfterUpdate()
UpdateCtrl Ctl9, Parent.EmployeeID
End Sub
Private Sub Ctl9_DblClick(Cancel As Integer)
' Check for BofK
BofK EmployeeID, Me.Controls("9").Tag
End Sub
Private Sub Form_Load()
' Dim NumTest As Integer
' Dim lblCnt As Integer
' Dim ctrlidx As Integer
' Dim i As Integer
' ' Fill in the field caption values (JDS names)
'
' On Error GoTo Form_load_Error
'
' lblCnt = Recordset.Fields.Count
' ctrlidx = 9 ' Starting point for
' For i = 4 To lblCnt - 1
' Controls.Item(ctrlidx).Caption = DLookup("Name", "Location",
"LocationID=" & Recordset(i).Name)
'
' ' Check if location ID is in the ParentID column. If so then this
' ' column is a JDS of a Body of Knowledge, so highlight
' If DCount("LocationID", "Location", "ParentID=" &
Recordset(i).Name) > 0 Then
' Controls.Item(ctrlidx).BackColor = 65280
' Me.lbl4.FormatConditions.Delete
' Else
' Controls.Item(ctrlidx).BackColor = -2147483643
' End If
'
' ctrlidx = ctrlidx + 2
' Next i
'
' ' Set other controls to invisible
' ctrlidx = ctrlidx - 1
' For i = lblCnt To 15
' Controls.Item(ctrlidx).Visible = False
' ctrlidx = ctrlidx + 2
' Next i
'
'Form_load_Error:
' ' Expect to come here. If the run time error
'
End Sub
Public Sub BofK(EmployeeID As Long, LocationID As String)
Dim dataOpenMode As Integer
' Check for Body of Knowledge. If it exists then display the dialog
If DCount("LocationID", "Location", "ParentID=" & LocationID) > 0 Then
If Parent.Name = "Employee" Then
dataOpenMode = acFormEdit
Else
dataOpenMode = acFormReadOnly
End If
' Bring up BofK dialog modal. Pass employee ID and JDS location
DoCmd.OpenForm "BofK", , , , dataOpenMode, acDialog, EmployeeID &
"," & LocationID
End If
End Sub
Thanks for your help.
Best Regards,
Leif
