Private Sub subselectstudy()
'On Error Resume Next
Dim xopen As Boolean
Me.fullsub.SourceObject = ""
Me.fullsub.Visible = False
Me.mainsub.Visible = True
Me.datasub.Visible = True
set_Estimate_Menu_off
Me.Com_SelectStudy.SetFocus
set_Estimate_Menu_on
' here message if necessary
' *************
'switch off Estimate if Study not selected
Me.Com_SelectEstimate.Visible = False
Me.datasub.Visible = True
Me.datasub.SourceObject = ""
' init Study Selection
Me.mainsub.SourceObject = "substudylist"
Me.mainsub.Visible = True
Forms!Estimate!mainsub!f_selected_study.Width = GlobalMaindataWidth
Forms!Estimate!mainsub!f_selected_study.Height = 2990
set_Estimate_Menu_on
'check if XID & Study available
Dim xID As Variant
xID = Nz(Me.xID)
If StudyExists(xID) Then ---------------------------------------------------------> an dieser Stelle kommt der Laufzeitfehler
xopen = DLookup("[open]", "cost_studies", "[id] = " & xID)
Forms!Estimate!mainsub!Filter_Plant = 100
Forms!Estimate!mainsub!Filter_Status = 5 ' look for all Studies when open form
'look for open or closed studies
'If xopen = True Then
'Forms!Estimate!mainsub!Filter_Status = 1
'Else
'Forms!Estimate!mainsub!Filter_Status = 2
'End If
'On Error Resume Next
Forms!Estimate!mainsub.Form.GetStudyData
End If
'LISTE DURCHLAUFEN
Dim ctl As Control
Dim varElement As Variant
Dim Xvalue As Boolean
Set ctl = Forms!Estimate!mainsub!f_selected_study
'check if Xid is included in Listbox from mainsub (Forms!Estimate!mainsub!f_selected_study)
For varElement = 1 To ctl.ListCount - 1
If Int(ctl.Column(0, varElement)) = xID Then
Xvalue = True
Forms!Estimate!mainsub!f_selected_study = xID
Else
'xvalue = False
End If
Next varElement
'On Error Resume Next
If Xvalue Then
'set Study ID & Titel in Estimate Form
Me.lab_subtitel.Caption = "" & Forms!Estimate!mainsub!f_selected_study.Column(0) & ": " & UCase(Forms!Estimate!mainsub!f_selected_study.Column(5))
'set subform "datasub" SourceObject
Me.datasub.SourceObject = "substudy"
Me.Com_SelectEstimate.Visible = True
Me.datasub.Visible = True
If Forms!Estimate!datasub!f_open = False Then
Forms!Estimate!datasub!RefOpen = "locked"
End If
'error message to fixit
On Error Resume Next
Forms!Estimate!datasub.Form.Recordset.FindFirst "ID = " & xID
Else
Me.Status = "no Study ID found, please select Study"
Me.datasub.SourceObject = "substudy"
Me.Com_SelectEstimate.Visible = True
Me.datasub.Visible = True
'Forms!Estimate!datasub.Form.Recordset.AddNew
' study not existing
' what happens then
Exit Sub
End If
End Sub
Private Sub subselectestimate()
On Error Resume Next
Me.fullsub.SourceObject = ""
Me.fullsub.Visible = False
Me.mainsub.Visible = True
Me.datasub.Visible = True
set_Estimate_Menu_off
Me.Com_SelectEstimate.SetFocus
set_Estimate_Menu_on
Forms!Estimate!mainsub!f_select_estimate.Height = 2950
Dim z As Integer
z = Nz(DCount("[ID]", "cost_estimate", ("[StudyID]=[forms]![estimate]![xID]")))
If z < 1 Then
'Exit Sub
End If
Me.datasub.SourceObject = "subestimate"
'SELECT cost_estimate.StudyID, cost_estimate.OpNo, cost_estimate.AreaNo, cost_estimate.CatNo, cost_estimate.Description, cost_estimate.Total, cost_estimate.reference, cost_estimate.refdate, * FROM cost_estimate WHERE (((cost_estimate.StudyID)=[FOrms]![ESTIM
Forms!Estimate!datasub.SetFocus
On Error Resume Next ' wenn record gesperrt ist
Forms!Estimate!datasub!f_SelectArea.SetFocus
End Sub
|