Chimp8471
Registered User.
- Local time
- Today, 23:35
- Joined
- Mar 18, 2003
- Messages
- 353
I am having a problem entering data into the company database, i keep getting the following message
You can't assign to this object
when i click a button to add the data from the main form into the subform.
this all worked fine until today.
the code behind the problem button is displayed below, i have very little knowledge in how this code operates.
please help
Andy
Option Compare Database
Option Explicit
Dim dbs As Database
Dim rstNewEvents As Recordset
Dim rstCodes As Recordset
Dim rstProdchange As Recordset
Dim rstCIP As Recordset
Dim rstMaint As Recordset
Dim dRunning As Integer
Private Sub AddEvent_Click()
' This event procedure adds events to tblevents for the daycode and line specified. The daycode and line are actually
' linked to tblproduction, which ensure that the events are correctly allocated. This procedure determines which of
' the event grouping (minor stop, major stops, CIP, maintenance, ProdChange or breakdown) based on whether a part has
' been replaced, whether the event code has been defined as a specific type, or failing that on the basis of duration
On Error GoTo Err_AddEvent_Click
Set dbs = DBEngine.Workspaces(0).OpenDatabase("\\tech02\oeedata\oeedata.mdb")
'Sets the destination for data
Set rstNewEvents = dbs.OpenRecordset("tblEvents")
' Sets the tables which contain the event codes that describe event types
Set rstCodes = dbs.OpenRecordset("tblCodes")
Set rstProdchange = dbs.OpenRecordset("tblprodchangecodes")
Set rstCIP = dbs.OpenRecordset("tblCIPcodes")
Set rstMaint = dbs.OpenRecordset("tblMaintCodes")
'Data collected on the form is stored in these variables
Dim dDayCode As Integer
Dim dLine As String
Dim dEvent As String
Dim dDuration As Integer
Dim dPart As Boolean
'The various fields on the events table that the form will write to
Dim rMin As Integer
Dim rMaj As Integer
Dim rCIP As Integer
Dim rBrk As Integer
Dim rPrd As Integer
Dim rMain As Integer
Dim strMsg As String
'Set to zero so that they have a value when the writing back is done, ie not null
rMin = 0
rMaj = 0
rCIP = 0
rBrk = 0
rPrd = 0
rMain = 0
'Various error checks to ensure that fields have been filled in correctly
If IsNull([Forms]![frmdataentry]![DayCode]) Then
Call MsgBox(prompt:="A Day Code is Required." & vbCrLf & "" & vbCrLf & "Please Enter a Day Code.", _
Buttons:=vbInformation + vbOKOnly + vbDefaultButton1, _
Title:="No Day Code Entered!")
GoTo Notallfields
End If
If IsNull([Forms]![frmdataentry]![Line]) Then
Call MsgBox(prompt:="A Line is Required." & vbCrLf & "" & vbCrLf & "Please Enter a Line.", _
Buttons:=vbInformation + vbOKOnly + vbDefaultButton1, _
Title:="No Line Entered!")
GoTo Notallfields
End If
If IsNull([Forms]![frmdataentry]![SelectEvent]) Then
Call MsgBox(prompt:="An event code is required." & vbCrLf & "" & vbCrLf & "Please enter an event code.", _
Buttons:=vbInformation + vbOKOnly + vbDefaultButton1, _
Title:="No Event Code Entered!")
GoTo Notallfields
End If
If IsNull([Forms]![frmdataentry]![SelectDuration]) Then
Call MsgBox(prompt:="An Event Duration is Required." & vbCrLf & "" & vbCrLf & "Please Enter an Event Duration.", _
Buttons:=vbInformation + vbOKOnly + vbDefaultButton1, _
Title:="No Duration Entered!")
GoTo Notallfields
End If
'Data is gathered from fields on the form and placed in variables
dDayCode = [Forms]![frmdataentry]![DayCode]
dLine = [Forms]![frmdataentry]![Line]
dEvent = [Forms]![frmdataentry]![SelectEvent]
dDuration = [Forms]![frmdataentry]![SelectDuration]
dPart = [Forms]![frmdataentry]![PartRepl]
dRunning = dRunning + dDuration
Me![total downtime] = dRunning
'Using the event code in 'dEvent', the event is searched for in the tables that contain codes for specific events
rstProdchange.Index = "PrimaryKey"
rstProdchange.Seek "=", dEvent
rstCIP.Index = "PrimaryKey"
rstCIP.Seek "=", dEvent
rstMaint.Index = "PrimaryKey"
rstMaint.Seek "=", dEvent
'If the 'part replaced' bix is ticked then the event is automatically determined as a breakdown, and allocated as such
If dPart = True Then
rBrk = dDuration
'if devent was found in the CIPcode table, CIP field is set to the duration
ElseIf Not rstCIP.NoMatch Then
If dDuration > 150 Then
strMsg = "CIP value set to over 2 and half hours. Are you sure this correct?"
If MsgBox(strMsg, vbYesNo, "High CIP Time") = vbNo Then Exit Sub
End If
rCIP = dDuration
'if devent was found in the ProdChgcode table, Prodcng field is set to the duration
ElseIf Not rstProdchange.NoMatch Then
rPrd = dDuration
'if devent was found in the maintcode table, maint field is set to the duration
ElseIf Not rstMaint.NoMatch Then
rMain = dDuration
'If we have got this far then is either a major or minor stop type
'If duration is greater or equal to 10 minutes,then it is defined as a major stop
ElseIf dDuration >= 10 Then
rMaj = dDuration
'Otherwise it must a minor stop....
Else
rMin = dDuration
End If
'New field added to tblEvents
rstNewEvents.AddNew
'adds daycode, line and eventcodes
rstNewEvents!DayCode = dDayCode
rstNewEvents!Line = dLine
rstNewEvents!EventCode = dEvent
'Allocates the following fields
'Only one of these should have a number that isn't zero, and that number is the dDuration value
rstNewEvents!Minorstop = rMin
rstNewEvents!Majorstop = rMaj
rstNewEvents!cip = rCIP
rstNewEvents!productchange = rPrd
rstNewEvents!breakdowns = rBrk
rstNewEvents!maintenance = rMain
'Data is added newfield in tblevents
rstNewEvents.Update
'some controls on form are reset, ready for next event
[Forms]![frmdataentry]![SelectEvent] = Null
Me!SelectEvent.SetFocus
[Forms]![frmdataentry]![SelectDuration] = Null
[Forms]![frmdataentry]![PartRepl] = False
'Form refreshed so that event just added is displayed in the subform
'NOTE The new event is added at the top. This is achieved bysort the subform in desc order on the autonumbered
'eventcodenumberlog. This field is actually in the subform, but has 0 width so is not visible
[Forms]![frmdataentry].Refresh
Exit_AddEvent_Click:
Exit Sub
Err_AddEvent_Click:
MsgBox Err.Description
Resume Exit_AddEvent_Click
'Not sure what this is for
Notallfields:
Exit Sub
End Sub
Private Sub NextRecord_Click()
' When data entry is finished for one line, the user clicks this button to move onto the next line
' FrmDataentry is actually linked straight into tblProduction, so this procedure is about making sure the form stays
' nice and ready when the button is pressed
On Error GoTo Err_NextRecord_Click
Dim Currentday As Integer
'Takes current daycode and stores it
Currentday = [Forms]![frmdataentry]![DayCode]
'Sets various fields to empty
[Forms]![frmdataentry]![SelectEvent] = Null
[Forms]![frmdataentry]![SelectDuration] = Null
[Forms]![frmdataentry]![PartRepl] = False
dRunning = 0
' Adds new record
DoCmd.GoToRecord , , acNewRec
'Refreshes form to show changes and clear the subform for new events
[Forms]![frmdataentry].Refresh
'Puts the daycode back, as this will remain the same
[Forms]![frmdataentry]![DayCode] = Currentday
Exit_NextRecord_Click:
Exit Sub
Err_NextRecord_Click:
MsgBox Err.Description
Resume Exit_NextRecord_Click
End Sub
'These calc functions use the mini calculator to update variuos fields
Private Sub outcalc_Click()
If IsNull(morn) Then morn = 0
If IsNull(after) Then after = 0
If IsNull(night) Then night = 0
Me![output(c)] = morn + after + night
morn = Null
after = Null
night = Null
End Sub
Private Sub packcalc_Click()
If IsNull(morn) Then morn = 0
If IsNull(after) Then after = 0
If IsNull(night) Then night = 0
Me![stdpack(b)] = morn + after + night
morn = Null
after = Null
night = Null
End Sub
Private Sub plancalc_Click()
If (morn + after + night) > 1440 Then
MsgBox "planned time can not exceed 1440 mins in a day"
Exit Sub
End If
If IsNull(morn) Then morn = 0
If IsNull(after) Then after = 0
If IsNull(night) Then night = 0
Me!PlannedTime = morn + after + night
morn = Null
after = Null
night = Null
End Sub
Private Sub Impcalc_Click()
If IsNull(morn) Then morn = 0
If IsNull(after) Then after = 0
If IsNull(night) Then night = 0
Me![Impressions(A)] = morn + after + night
morn = Null
after = Null
night = Null
End Sub
Private Sub StdPack_b__AfterUpdate()
'This event procedure is designed to give a visual indication that more packs were produced than pack impressions used
' As this can occur if stock from another time is added back, this is allowable, hence a simple colour change
'data entry is not otherwise affected.
If [stdpack(b)] > [Impressions(A)] Then
[stdpack(b)].ForeColor = RGB(255, 0, 0)
End If
End Sub
Private Sub Command33_Click()
On Error GoTo Err_Command33_Click
Screen.PreviousControl.SetFocus
DoCmd.FindNext
Exit_Command33_Click:
Exit Sub
Err_Command33_Click:
MsgBox Err.Description
Resume Exit_Command33_Click
End Sub
Private Sub DNR_Click()
On Error GoTo Err_DNR_Click
Dim strMsg As String
strMsg = "Clicking 'Yes' will completely remove this record@Only click 'Yes' if you are sure this line did not run@This action can not be undone@Are you sure you wish to delete this record?@(You will be prompted again for confirmation)"
If MsgBox(strMsg, vbYesNo, "Did Not Run") = vbNo Then Exit Sub
DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70
Exit_DNR_Click:
Exit Sub
Err_DNR_Click:
MsgBox Err.Description
Resume Exit_DNR_Click
End Sub
You can't assign to this object
when i click a button to add the data from the main form into the subform.
this all worked fine until today.
the code behind the problem button is displayed below, i have very little knowledge in how this code operates.
please help
Andy
Option Compare Database
Option Explicit
Dim dbs As Database
Dim rstNewEvents As Recordset
Dim rstCodes As Recordset
Dim rstProdchange As Recordset
Dim rstCIP As Recordset
Dim rstMaint As Recordset
Dim dRunning As Integer
Private Sub AddEvent_Click()
' This event procedure adds events to tblevents for the daycode and line specified. The daycode and line are actually
' linked to tblproduction, which ensure that the events are correctly allocated. This procedure determines which of
' the event grouping (minor stop, major stops, CIP, maintenance, ProdChange or breakdown) based on whether a part has
' been replaced, whether the event code has been defined as a specific type, or failing that on the basis of duration
On Error GoTo Err_AddEvent_Click
Set dbs = DBEngine.Workspaces(0).OpenDatabase("\\tech02\oeedata\oeedata.mdb")
'Sets the destination for data
Set rstNewEvents = dbs.OpenRecordset("tblEvents")
' Sets the tables which contain the event codes that describe event types
Set rstCodes = dbs.OpenRecordset("tblCodes")
Set rstProdchange = dbs.OpenRecordset("tblprodchangecodes")
Set rstCIP = dbs.OpenRecordset("tblCIPcodes")
Set rstMaint = dbs.OpenRecordset("tblMaintCodes")
'Data collected on the form is stored in these variables
Dim dDayCode As Integer
Dim dLine As String
Dim dEvent As String
Dim dDuration As Integer
Dim dPart As Boolean
'The various fields on the events table that the form will write to
Dim rMin As Integer
Dim rMaj As Integer
Dim rCIP As Integer
Dim rBrk As Integer
Dim rPrd As Integer
Dim rMain As Integer
Dim strMsg As String
'Set to zero so that they have a value when the writing back is done, ie not null
rMin = 0
rMaj = 0
rCIP = 0
rBrk = 0
rPrd = 0
rMain = 0
'Various error checks to ensure that fields have been filled in correctly
If IsNull([Forms]![frmdataentry]![DayCode]) Then
Call MsgBox(prompt:="A Day Code is Required." & vbCrLf & "" & vbCrLf & "Please Enter a Day Code.", _
Buttons:=vbInformation + vbOKOnly + vbDefaultButton1, _
Title:="No Day Code Entered!")
GoTo Notallfields
End If
If IsNull([Forms]![frmdataentry]![Line]) Then
Call MsgBox(prompt:="A Line is Required." & vbCrLf & "" & vbCrLf & "Please Enter a Line.", _
Buttons:=vbInformation + vbOKOnly + vbDefaultButton1, _
Title:="No Line Entered!")
GoTo Notallfields
End If
If IsNull([Forms]![frmdataentry]![SelectEvent]) Then
Call MsgBox(prompt:="An event code is required." & vbCrLf & "" & vbCrLf & "Please enter an event code.", _
Buttons:=vbInformation + vbOKOnly + vbDefaultButton1, _
Title:="No Event Code Entered!")
GoTo Notallfields
End If
If IsNull([Forms]![frmdataentry]![SelectDuration]) Then
Call MsgBox(prompt:="An Event Duration is Required." & vbCrLf & "" & vbCrLf & "Please Enter an Event Duration.", _
Buttons:=vbInformation + vbOKOnly + vbDefaultButton1, _
Title:="No Duration Entered!")
GoTo Notallfields
End If
'Data is gathered from fields on the form and placed in variables
dDayCode = [Forms]![frmdataentry]![DayCode]
dLine = [Forms]![frmdataentry]![Line]
dEvent = [Forms]![frmdataentry]![SelectEvent]
dDuration = [Forms]![frmdataentry]![SelectDuration]
dPart = [Forms]![frmdataentry]![PartRepl]
dRunning = dRunning + dDuration
Me![total downtime] = dRunning
'Using the event code in 'dEvent', the event is searched for in the tables that contain codes for specific events
rstProdchange.Index = "PrimaryKey"
rstProdchange.Seek "=", dEvent
rstCIP.Index = "PrimaryKey"
rstCIP.Seek "=", dEvent
rstMaint.Index = "PrimaryKey"
rstMaint.Seek "=", dEvent
'If the 'part replaced' bix is ticked then the event is automatically determined as a breakdown, and allocated as such
If dPart = True Then
rBrk = dDuration
'if devent was found in the CIPcode table, CIP field is set to the duration
ElseIf Not rstCIP.NoMatch Then
If dDuration > 150 Then
strMsg = "CIP value set to over 2 and half hours. Are you sure this correct?"
If MsgBox(strMsg, vbYesNo, "High CIP Time") = vbNo Then Exit Sub
End If
rCIP = dDuration
'if devent was found in the ProdChgcode table, Prodcng field is set to the duration
ElseIf Not rstProdchange.NoMatch Then
rPrd = dDuration
'if devent was found in the maintcode table, maint field is set to the duration
ElseIf Not rstMaint.NoMatch Then
rMain = dDuration
'If we have got this far then is either a major or minor stop type
'If duration is greater or equal to 10 minutes,then it is defined as a major stop
ElseIf dDuration >= 10 Then
rMaj = dDuration
'Otherwise it must a minor stop....
Else
rMin = dDuration
End If
'New field added to tblEvents
rstNewEvents.AddNew
'adds daycode, line and eventcodes
rstNewEvents!DayCode = dDayCode
rstNewEvents!Line = dLine
rstNewEvents!EventCode = dEvent
'Allocates the following fields
'Only one of these should have a number that isn't zero, and that number is the dDuration value
rstNewEvents!Minorstop = rMin
rstNewEvents!Majorstop = rMaj
rstNewEvents!cip = rCIP
rstNewEvents!productchange = rPrd
rstNewEvents!breakdowns = rBrk
rstNewEvents!maintenance = rMain
'Data is added newfield in tblevents
rstNewEvents.Update
'some controls on form are reset, ready for next event
[Forms]![frmdataentry]![SelectEvent] = Null
Me!SelectEvent.SetFocus
[Forms]![frmdataentry]![SelectDuration] = Null
[Forms]![frmdataentry]![PartRepl] = False
'Form refreshed so that event just added is displayed in the subform
'NOTE The new event is added at the top. This is achieved bysort the subform in desc order on the autonumbered
'eventcodenumberlog. This field is actually in the subform, but has 0 width so is not visible
[Forms]![frmdataentry].Refresh
Exit_AddEvent_Click:
Exit Sub
Err_AddEvent_Click:
MsgBox Err.Description
Resume Exit_AddEvent_Click
'Not sure what this is for
Notallfields:
Exit Sub
End Sub
Private Sub NextRecord_Click()
' When data entry is finished for one line, the user clicks this button to move onto the next line
' FrmDataentry is actually linked straight into tblProduction, so this procedure is about making sure the form stays
' nice and ready when the button is pressed
On Error GoTo Err_NextRecord_Click
Dim Currentday As Integer
'Takes current daycode and stores it
Currentday = [Forms]![frmdataentry]![DayCode]
'Sets various fields to empty
[Forms]![frmdataentry]![SelectEvent] = Null
[Forms]![frmdataentry]![SelectDuration] = Null
[Forms]![frmdataentry]![PartRepl] = False
dRunning = 0
' Adds new record
DoCmd.GoToRecord , , acNewRec
'Refreshes form to show changes and clear the subform for new events
[Forms]![frmdataentry].Refresh
'Puts the daycode back, as this will remain the same
[Forms]![frmdataentry]![DayCode] = Currentday
Exit_NextRecord_Click:
Exit Sub
Err_NextRecord_Click:
MsgBox Err.Description
Resume Exit_NextRecord_Click
End Sub
'These calc functions use the mini calculator to update variuos fields
Private Sub outcalc_Click()
If IsNull(morn) Then morn = 0
If IsNull(after) Then after = 0
If IsNull(night) Then night = 0
Me![output(c)] = morn + after + night
morn = Null
after = Null
night = Null
End Sub
Private Sub packcalc_Click()
If IsNull(morn) Then morn = 0
If IsNull(after) Then after = 0
If IsNull(night) Then night = 0
Me![stdpack(b)] = morn + after + night
morn = Null
after = Null
night = Null
End Sub
Private Sub plancalc_Click()
If (morn + after + night) > 1440 Then
MsgBox "planned time can not exceed 1440 mins in a day"
Exit Sub
End If
If IsNull(morn) Then morn = 0
If IsNull(after) Then after = 0
If IsNull(night) Then night = 0
Me!PlannedTime = morn + after + night
morn = Null
after = Null
night = Null
End Sub
Private Sub Impcalc_Click()
If IsNull(morn) Then morn = 0
If IsNull(after) Then after = 0
If IsNull(night) Then night = 0
Me![Impressions(A)] = morn + after + night
morn = Null
after = Null
night = Null
End Sub
Private Sub StdPack_b__AfterUpdate()
'This event procedure is designed to give a visual indication that more packs were produced than pack impressions used
' As this can occur if stock from another time is added back, this is allowable, hence a simple colour change
'data entry is not otherwise affected.
If [stdpack(b)] > [Impressions(A)] Then
[stdpack(b)].ForeColor = RGB(255, 0, 0)
End If
End Sub
Private Sub Command33_Click()
On Error GoTo Err_Command33_Click
Screen.PreviousControl.SetFocus
DoCmd.FindNext
Exit_Command33_Click:
Exit Sub
Err_Command33_Click:
MsgBox Err.Description
Resume Exit_Command33_Click
End Sub
Private Sub DNR_Click()
On Error GoTo Err_DNR_Click
Dim strMsg As String
strMsg = "Clicking 'Yes' will completely remove this record@Only click 'Yes' if you are sure this line did not run@This action can not be undone@Are you sure you wish to delete this record?@(You will be prompted again for confirmation)"
If MsgBox(strMsg, vbYesNo, "Did Not Run") = vbNo Then Exit Sub
DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70
Exit_DNR_Click:
Exit Sub
Err_DNR_Click:
MsgBox Err.Description
Resume Exit_DNR_Click
End Sub