Rod-
Is there any code in AuditChanges that changes the value of ID_Answer? You could also try doing a Debug.Print Me.ID_Answer and Debug.Print Me.Parent!ID_Answer in the Before Update code to see if the values are the same on entry to that code.
John Viescas, Author
Effective SQL
SQL Queries for Mere Mortals
Microsoft Access 2010 Inside Out
Microsoft Access 2007 Inside Out
Microsoft Access 2003 Inside Out
Building Microsoft Access Applications
(Paris, France)
On Jul 2, 2016, at 8:12 PM, desertscroller@cox.net [MS_Access_Professionals] <MS_Access_Professionals@yahoogroups.com> wrote:
There is code in the subform. The subform is made up of 10 textboxes and 10 checkboxes. The controls (expect the first of each) is locked. Once data is entered into the 1st textbox and losses focus the next textbox and checkbox are unlocked:
Private Sub Option1_LostFocus()
If Len(Me.Option1.Value) Then
Option2.Locked = False
Ck_Opt2.Locked = False
End If
End Sub
Option2.Locked = False
Ck_Opt2.Locked = False
End If
End Sub
The 1st 9 textbox have the same type of routine.
The checkboxes are used to set which textbox represents the correct solution. Only one checkbox can be selected so there is code to ensure the last checkbox selected is the only one check.
Private Sub Ck_Opt1_Click()
If Ck_Opt1 Then
Clear_Ck_Opt ("Ck_Opt1")
Else
End If
End Sub
If Ck_Opt1 Then
Clear_Ck_Opt ("Ck_Opt1")
Else
End If
End Sub
Each checkbox have the same type of routine.
The Clear_Ck_Opt function is used to ensure all other checkboxes are set to false.
Private Sub Clear_Ck_Opt(NotCtrl As String)
Dim ctl As Control
Dim tmpStr As String
Dim ctl As Control
Dim tmpStr As String
On Error GoTo ErrorHandler
For Each ctl In Me.Controls
If ctl.ControlType = acCheckBox Then
If ctl.Name <> NotCtrl Then
tmpStr = ctl.Name
Me.Controls(tmpStr).Value = False
End If
End If
Next ctl
ID_Answer = CLng(Mid(NotCtrl, 7)) ' Answer is checkbox not cleared
If ctl.ControlType = acCheckBox Then
If ctl.Name <> NotCtrl Then
tmpStr = ctl.Name
Me.Controls(tmpStr).Value = False
End If
End If
Next ctl
ID_Answer = CLng(Mid(NotCtrl, 7)) ' Answer is checkbox not cleared
ExitPoint:
On Error GoTo 0
Exit Sub
ErrorHandler:
Call LogError(Err.Number, Err.Description, "frmEditQ_Sub-Clear_Ck_Opt()")
Resume ExitPoint
End Sub
On Error GoTo 0
Exit Sub
ErrorHandler:
Call LogError(Err.Number, Err.Description, "frmEditQ_Sub-Clear_Ck_Opt()")
Resume ExitPoint
End Sub
There are two other pieces of code; Form_BeforeUpdate and Check_Answers.
Private Sub Form_BeforeUpdate(Cancel As Integer)
Dim varTPTID As Variant
Dim strTPTNo As String
Dim varTPTID As Variant
Dim strTPTNo As String
'If the form data has changed a message is shown asking if
'the changes should be saved. If the answer is no then
'the changes are undone
On Error GoTo BeforeUpdate_Error
If (Check_Answers) Then
If MsgBox("Do you want to save this record? ", _
vbYesNo + vbQuestion, "Save Record") = vbNo Then
Me.Undo
Else
If Me.NewRecord Then
Me.ID_Question = GetQuestionID
Call AuditChanges(Me, "ID_Answer", "NEW")
Else
Call AuditChanges(Me, "ID_Answer", "EDIT")
End If
End If
Else
MsgBox "Not valid data. Verify the following." & vbCrLf _
& " 1. At least two (2) answers have been entered." & vbCrLf _
& " 2. Answer checkbox has been selected to a valid answer."
Me.Undo
Exit Sub
End If
'the changes should be saved. If the answer is no then
'the changes are undone
On Error GoTo BeforeUpdate_Error
If (Check_Answers) Then
If MsgBox("Do you want to save this record? ", _
vbYesNo + vbQuestion, "Save Record") = vbNo Then
Me.Undo
Else
If Me.NewRecord Then
Me.ID_Question = GetQuestionID
Call AuditChanges(Me, "ID_Answer", "NEW")
Else
Call AuditChanges(Me, "ID_Answer", "EDIT")
End If
End If
Else
MsgBox "Not valid data. Verify the following." & vbCrLf _
& " 1. At least two (2) answers have been entered." & vbCrLf _
& " 2. Answer checkbox has been selected to a valid answer."
Me.Undo
Exit Sub
End If
BeforeUpdate_Exit:
Exit Sub
Exit Sub
BeforeUpdate_Error:
MsgBox Err.Description
If Not LogError(Err.Number, Err.Description, "Form_BeforeUpdate()", "Form_frmEditQ_Sub") Then
Me.Undo
End If
Resume BeforeUpdate_Exit
MsgBox Err.Description
If Not LogError(Err.Number, Err.Description, "Form_BeforeUpdate()", "Form_frmEditQ_Sub") Then
Me.Undo
End If
Resume BeforeUpdate_Exit
End Sub
Private Function Check_Answers() As Boolean
Dim ctl As Control
Dim tmpName As String
Dim tmpAnsCnt As Long
Dim boolAns As Boolean
Dim tmpAns As Long
Dim ctl As Control
Dim tmpName As String
Dim tmpAnsCnt As Long
Dim boolAns As Boolean
Dim tmpAns As Long
On Error GoTo ErrorHandler
' Determine if more than 1 answer is available
tmpAnsCnt = 0
For Each ctl In Me.Controls
If ctl.ControlType = acTextBox And InStr(1, ctl.Name, "Option", 1) Then
tmpName = ctl.Name
If Not (ctl.Locked) And Len(Me.Controls(tmpName).Value > 0) Then
tmpAnsCnt = tmpAnsCnt + 1
End If
End If
Next ctl
' Determine which is answer is selected
boolAns = False
For Each ctl In Me.Controls
If ctl.ControlType = acCheckBox And InStr(1, ctl.Name, "Ck_Opt", 1) Then
tmpName = ctl.Name
If (Not (ctl.Locked)) And (Me.Controls(tmpName)) Then
boolAns = True
tmpAns = CLng(Mid(tmpName, 7))
tmpName = "Option" & tmpAns
If IsNull(Me.Controls(tmpName).Value) Or Me.Controls(tmpName).Value = "" Then
boolAns = False
Else
Exit For
End If
End If
End If
Next ctl
If tmpAnsCnt > 1 And boolAns Then
Check_Answers = True
Else
Check_Answers = False
End If
ExitPoint:
On Error GoTo 0
Exit Function
ErrorHandler:
Call LogError(Err.Number, Err.Description, "frmEditQ_Sub-Function Check_Answers")
Resume ExitPoint
' Determine if more than 1 answer is available
tmpAnsCnt = 0
For Each ctl In Me.Controls
If ctl.ControlType = acTextBox And InStr(1, ctl.Name, "Option", 1) Then
tmpName = ctl.Name
If Not (ctl.Locked) And Len(Me.Controls(tmpName).Value > 0) Then
tmpAnsCnt = tmpAnsCnt + 1
End If
End If
Next ctl
' Determine which is answer is selected
boolAns = False
For Each ctl In Me.Controls
If ctl.ControlType = acCheckBox And InStr(1, ctl.Name, "Ck_Opt", 1) Then
tmpName = ctl.Name
If (Not (ctl.Locked)) And (Me.Controls(tmpName)) Then
boolAns = True
tmpAns = CLng(Mid(tmpName, 7))
tmpName = "Option" & tmpAns
If IsNull(Me.Controls(tmpName).Value) Or Me.Controls(tmpName).Value = "" Then
boolAns = False
Else
Exit For
End If
End If
End If
Next ctl
If tmpAnsCnt > 1 And boolAns Then
Check_Answers = True
Else
Check_Answers = False
End If
ExitPoint:
On Error GoTo 0
Exit Function
ErrorHandler:
Call LogError(Err.Number, Err.Description, "frmEditQ_Sub-Function Check_Answers")
Resume ExitPoint
End Function
That is the extent of the code. The LogError routine has been in all my apps and work good in logging errors.
And AuditChanges is used to create a log of when a record is created or edited; again is used in all my and works fine with no issues.
I am in the process of re-constructing the subform and main form to see if I have done something in error.
Rod
---In MS_Access_Professionals@yahoogroups.com, <JohnV@...> wrote :
Rod-
Either you have a corrupted form, or you have some code that is interfering with the setting of the key on the subform. Do you have any code in the subform?
John Viescas, Author
Effective SQL
SQL Queries for Mere Mortals
Microsoft Access 2010 Inside Out
Microsoft Access 2007 Inside Out
Microsoft Access 2003 Inside Out
Building Microsoft Access Applications
(Paris, France)
On Jul 2, 2016, at 3:53 AM, desertscroller@... [MS_Access_Professionals] <MS_Access_Professionals@yahoogroups.com> wrote:
When I open the main form with a filter, its filtered records appear. If the subform has no data everything appears good. When new data is added to the subform the associated ID_Question appears correctly but the primary key of the subform data is the count of records + 1 of the filtered main form. Example: when the filter return 7 records and new data is added to the subform the primary is set to 8 instead of the next record in the table thereby causing an error of duplicate primary key values.
Rod
__._,_.___
Posted by: John Viescas <johnv@msn.com>
Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (4) |
Have you tried the highest rated email app?
With 4.5 stars in iTunes, the Yahoo Mail app is the highest rated email app on the market. What are you waiting for? Now you can access all your inboxes (Gmail, Outlook, AOL and more) in one place. Never delete an email again with 1000GB of free cloud storage.
.
__,_._,___
Tidak ada komentar:
Posting Komentar