在Access连续表格中进行考试

时间：2016-11-07 17:58:46

标签： access-vba ms-access-2010

我有一个问题让我感到难过。我正在尝试以Access连续形式创建包含50个问题的考试。每个问题可以是多项选择，也可以是真/假。我很难搞清楚的问题有两个：

  1. 如何让文本框显示一个问题，其中组合框将显示适合该问题的答案选项？ （tblQuestions有一个ID字段和问题，tblAnswerOptions也有一个ID字段和一个Test_Question_ID

    2. ie：ID = 1，Test_Question_ID = 1，Answer = Answer Option 1; ID = 2，Test_Question_ID = 1，Answer = Answer Option 2; ID = 3，Test_Question_ID = 1，答案=答案选项3

    1. 如何获取Access以将测试者的下拉答案记录到由ID，Student_ID，Test_Question_ID和Answer_ID组成的tblStudentAnswers中？

      2. 我觉得有一堆活动部件，我不知道从哪里开始将它们连接在一起。感谢您提供任何帮助/建议！

2 个答案:

答案 0 :(得分：0)

你有没有听过这样的表达，＆＃34;你无法从这里到达那里。＆＃34;？

您的问题假定您将以与问题相同的形式获得答案组合框。您需要做的事实上有三种不同的形式。将成为＆＃34; test＆＃34;的主要表单，一个将显示问题的子表单 - 它可以是多项表单，因此用户可以滚动查询问题，以及第三个表单 - 答案形式，其中用户将选择他们的答案。

如果您希望能够一次显示所有问题以供用户滚动，问题表单和答案表单都必须是测试表单的子表单，因此您必须编写一些vba代码，每次使用问题表格更改问题表格时更新答案表格＆＃34;＆＃34;当前＆＃34;事件

您可以在答案表单中包含一个提交cmdbutton，用于检查答案中的值并将值提交给表格。

你需要拥有3种不同形式的原因是你的答案组合的行数源不断更新每个问题的不同答案，当你在问题的表格上更新组合框的行源时，你＆＃ 39;重新更新多个项目表格中每个问题的每个组合框，以便只回答这一个问题。

Preliminary setup idea

答案 1 :(得分：0)

我刚才做了类似的事情。您可以在一个表单上执行此操作，其中包含一个文本框和一个选项组，其中包含您对该问题的答案。我创建了一些查询，这些查询从可用问题列表中随机选择问题，然后一次一个地将问题放在表单上，​​并以随机顺序添加答案。一旦学生选择了答案并单击“下一步”，他们的答案就会被记录下来，然后将下一个问题和答案放在屏幕上。

显然，这是针对我的设置和要求的，但这应该会让你了解如何继续前进...... 

Private Sub Form_Load()
Dim rs As DAO.Recordset, Ars As DAO.Recordset
Dim x As Integer, iMaxQuiz As Integer
Dim sSQL As String
Dim lQNum As Long

  'Check that student has questions
  If DCount("NTID", "qFoundQuestions") = 0 Then
    'No questions for student - Exit
    MsgBox "No questions have been found for you.  If you think this is in error, please contact your manager.", vbCritical, "No Quiz for you!"
    Quit
  End If

  'Check if user has already passed quiz...if so, exit
  If IsNull(DLookup("Passed", "tblQuizzes", "Student='" & Forms!fLoginDialog.NTID & "'")) Then
    'Student has not taken quiz
  Else
    'Quiz taken
    iMaxQuiz = DMax("QuizID", "tblQuizzes", "Student='" & Forms!fLoginDialog.NTID & "'")
    If Not (DLookup("Passed", "tblQuizzes", "QuizID=" & iMaxQuiz)) Then
      'Quiz not passed
    Else
      MsgBox "You have already passed the quiz for this round.  Congratulations!", vbInformation, "No need to retake."
      Quit
    End If
  End If

  'Create Quiz
  sSQL = "INSERT INTO tblQuizzes (Student, Taken, Passed) " & _
         "VALUES ('" & Forms!fLoginDialog.NTID & "', #" & Now & "#, 0)"
  DoCmd.SetWarnings False
  DoCmd.RunSQL sSQL
  DoCmd.SetWarnings True
  Quiz = dLast("QuizID", "tblQuizzes", "Student ='" & Forms!fLoginDialog.NTID & "'")
  'Save to local Temp Table - lttSelectedQuestions
  DoCmd.SetWarnings False
  DoCmd.OpenQuery "mtqRandomQuestions", acViewNormal
  DoCmd.SetWarnings True

  'Set Row Numbers
  RandToRow "lttSelectedQuestions"

  Set rs = CurrentDb.OpenRecordset("lttSelectedQuestions")

  'Initiate Quiz
  QNum.Caption = QNum.Caption & 1

  'Set first Q
  Question = 1
  QuestionBody.Caption = rs!QuestionBody

  'Check if TRUE/FALSE question first
  If rs!MC2 <> "" Then
    'Not T/F - Randomly select answer order
    Answers 1
  Else
    'T/F - Set True as the first option and then assign which one is correct
    TFAnswers 1
  End If

  rs.Close
  Set rs = Nothing

End Sub
Private Sub TFAnswers(ByVal iQ As Integer)
Dim Ars As DAO.Recordset

  'Delete lttAnswers
  DoCmd.SetWarnings False
  DoCmd.RunSQL "DELETE * FROM lttAnswers"
  DoCmd.SetWarnings True

  Set Ars = CurrentDb.OpenRecordset("lttAnswers")
  Ars.AddNew
  Ars!AID = 1
  Ars!AnswerText = "TRUE"
  If DLookup("Answer", "lttSelectedQuestions", "Row = " & iQ) = "TRUE" Then
    Ars!Correct = True
  Else
    Ars!Correct = False
  End If
  Ars.Update

  Ars.AddNew
  Ars!AID = 2
  Ars!AnswerText = "FALSE"
  If DLookup("Answer", "lttSelectedQuestions", "Row = " & iQ) = "TRUE" Then
    Ars!Correct = False
  Else
    Ars!Correct = True
  End If
  Ars.Update

  'Insert into lttRandonAnswers
  DoCmd.SetWarnings False
  DoCmd.RunSQL "DELETE * FROM lttRandomAnswers"
  DoCmd.RunSQL "INSERT INTO lttRandomAnswers (Row, AID, AnswerText, Correct) VALUES (1, 1,'TRUE'," & DLookup("Correct", "lttAnswers", "AID=1") & ")"
  DoCmd.RunSQL "INSERT INTO lttRandomAnswers (Row, AID, AnswerText, Correct) VALUES (2, 2,'FALSE'," & DLookup("Correct", "lttAnswers", "AID=2") & ")"
  DoCmd.SetWarnings True

  'Assign OptionLabel.Captions
  OptionLabel1.Caption = "TRUE"
  OptionLabel2.Caption = "FALSE"
  Option3.Visible = False
  OptionLabel3.Caption = ""
  Option4.Visible = False
  OptionLabel4.Caption = ""

  Ars.Close
  Set Ars = Nothing

End Sub

Private Sub Answers(ByVal iQ As Integer)
Dim Ars As DAO.Recordset

  'Delete lttAnswers
  DoCmd.SetWarnings False
  DoCmd.RunSQL "DELETE * FROM lttAnswers"
  DoCmd.SetWarnings True

  Set Ars = CurrentDb.OpenRecordset("lttAnswers")
  Ars.AddNew
  Ars!AID = 1
  Ars!AnswerText = DLookup("Answer", "lttSelectedQuestions", "Row = " & iQ)
  Ars!Correct = True
  Ars.Update

  Ars.AddNew
  Ars!AID = 2
  Ars!AnswerText = DLookup("MC1", "lttSelectedQuestions", "Row = " & iQ)
  Ars!Correct = False
  Ars.Update

  Ars.AddNew
  Ars!AID = 3
  Ars!AnswerText = DLookup("MC2", "lttSelectedQuestions", "Row = " & iQ)
  Ars!Correct = False
  Ars.Update

  Ars.AddNew
  Ars!AID = 4
  Ars!AnswerText = DLookup("MC3", "lttSelectedQuestions", "Row = " & iQ)
  Ars!Correct = False
  Ars.Update

  'Run qRandomAnswers
  DoCmd.SetWarnings False
  DoCmd.OpenQuery "mtqRandomAnswers", acViewNormal
  DoCmd.SetWarnings True
  RandToRow "lttRandomAnswers"

  OTACheck

  'Assign OptionLabel.Captions
  OptionLabel1.Caption = DLookup("AnswerText", "lttRandomAnswers", "Row = 1")
  OptionLabel2.Caption = DLookup("AnswerText", "lttRandomAnswers", "Row = 2")
  OptionLabel3.Caption = DLookup("AnswerText", "lttRandomAnswers", "Row = 3")
  OptionLabel4.Caption = DLookup("AnswerText", "lttRandomAnswers", "Row = 4")

  If Not Option3.Visible Then
    Option3.Visible = True
    OptionLabel3.Visible = True
    Option4.Visible = True
    OptionLabel4.Visible = True
  End If

  Ars.Close
  Set Ars = Nothing

End Sub

'Check if there is an All of the Above or None of the Above answer...and place it as option 4
Private Sub OTACheck()
Dim rs As DAO.Recordset
Dim iAID As Integer
Dim sText As String
Dim bAns As Boolean

  Set rs = CurrentDb.OpenRecordset("lttRandomAnswers")

  Do Until rs.EOF
    If Right(Trim(rs!AnswerText), 12) = "of the above" And rs!Row <> 4 Then
      'Save to temp
      iAID = rs!AID
      sText = rs!AnswerText
      bAns = rs!Correct
      'Move last answer to this position
      rs.Edit
      rs!AID = DLookup("AID", "lttRandomAnswers", "Row = 4")
      rs!AnswerText = DLookup("AnswerText", "lttRandomAnswers", "Row = 4")
      rs!Correct = DLookup("Correct", "lttRandomAnswers", "Row = 4")
      rs.Update
      'Move Temp to last answer
      rs.MoveLast
      rs.Edit
      rs!AID = iAID
      rs!AnswerText = sText
      rs!Correct = bAns
      rs.Update
    End If
    rs.MoveNext
  Loop

  rs.Close
  Set rs = Nothing

End Sub

然后，当学生点击按钮移动到下一个问题时...... 

Private Sub bNextQ_Click()
Dim iQNum As Integer
Dim sSQL As String

  'Check that an answer has been selected
  If OGAnswers > 0 Then
    'Save Answer
    sSQL = "INSERT INTO tblQuizAnswers (Quiz, Question, SelectedAnswer, Correct) " & _
           "VALUES (" & Quiz & ", " & Question & ", " & OGAnswers & ", " & DLookup("Correct", "lttRandomAnswers", "Row=" & OGAnswers) & ")"
    DoCmd.SetWarnings False
    DoCmd.RunSQL sSQL
    DoCmd.SetWarnings True
  Else
    MsgBox "Please pick an answer.", vbCritical, "Answer missing"
    Exit Sub
  End If

  'Get next question
 '*****************************
  'Last Question?
  If IsNull(DLookup("QuestionBody", "lttSelectedQuestions", "Row = " & Question + 1)) Then
    DoCmd.Close acForm, Name, acSaveNo
    DoCmd.OpenForm "fResults", acNormal, , , , acWindowNormal
    Exit Sub
  End If
'*****************************
  Question = Question + 1
  QuestionBody.Caption = DLookup("QuestionBody", "lttSelectedQuestions", "Row = " & Question)

  'Prep form
  QNum.Caption = "Question #" & Question
  OGAnswers.DefaultValue = 0
  If DLookup("MC2", "lttSelectedQuestions", "Row = " & Question) <> "" Then
    'Not T/F - Randomly select answer order
    Answers Question
  Else
    'T/F - Set True as the first option and then assign which one is correct
    TFAnswers Question
  End If

End Sub
相关问题
最新问题