Re: [MS_AccessPros] Help with subform

 

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

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

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

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

ExitPoint:
    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

   '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

BeforeUpdate_Exit:
   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

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

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

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 

http://www.viescas.com/ 

(Paris, France)

On Jul 2, 2016, at 3:53 AM, desertscroller@... [MS_Access_Professionals] <MS_Access_Professionals@yahoogroups.com> wrote:

I have a form and subform combination.  The main form has a table as source and the subform with a separate table.  The two forms use a master and child fields "ID_Question".  ID_Question is the primary key on the main form and a normal field on the subform.

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: desertscroller@cox.net

---

Reply via web post

•

Reply to sender

•

Reply to group

•

Start a New Topic

•

Messages in this topic (3)

---

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.

---

Visit Your Group

• New Members 1

• Privacy • Unsubscribe • Terms of Use

.

__,_._,___