以访问连续形式进行考试
Making an Exam in an Access Continuous Form
我有一个问题让我很困惑。我正在尝试创建一个由 50 个问题组成的 Access 连续形式的考试。每个问题可以是选择题或 true/false。我很难弄清楚的问题是双重的：
- 如何让文本框显示问题，组合框将显示与该问题相关的适当答案选项？ （tblQuestions 有一个 ID 字段和问题，tblAnswerOptions 也有一个 ID 字段和一个 Test_Question_ID
即：ID=1，Test_Question_ID=1，答案=答案选项1； ID = 2，Test_Question_ID = 1，答案=答案选项2； ID = 3，Test_Question_ID = 1，答案 = 答案选项 3
- 如何获取访问权限以将应试者的下拉答案记录到由 ID、Student_ID、Test_Question_ID 和 Answer_ID 组成的 tblStudentAnswers 中？
我觉得有很多活动部件，我不确定从哪里开始 link 将它们全部放在一起。感谢任何 help/advice!
你有没有听过这个表达，"You can't get there from here."？
您的问题假设您的答案组合框与问题的形式相同。您需要做的实际上是拥有 3 个单独的表格。主表单将是 "test"，一个将显示问题的子表单 - 它可以是多个项目表单，因此用户可以滚动浏览问题，第三个表单 - 答案表单，用户将在其中select 他们的回答。
如果您希望能够一次显示所有问题供用户滚动浏览，则问题表单和答案表单都必须是测试表单的子表单，因此您必须编写一些vba 每次使用问题表单的 "on current" 事件更改问题表单时更新答案表单的代码。
您可以在答案表单中包含一个提交命令按钮，该按钮将检查他们答案中的值并将该值提交给 table。
你需要 3 种不同形式的原因是你的答案组合框的行源不断更新每个问题的不同答案，当你更新提出问题的形式上的组合框的行源时，您正在将多个项目表单中每个问题的每个组合框更新为仅对这个问题的答案。
Preliminary setup idea
我前段时间做过类似的事情。您可以在一个表单上完成，一个文本框和一个选项组，其中包含您对该问题有多少答案。我创建了几个查询，从可用问题列表中随机选择问题，然后一次将一个问题放在表单上，并以随机顺序添加答案。一旦学生选择了一个答案并点击下一步，他们的答案就会被记录下来，下一个问题和答案就会出现在屏幕上。
显然，这是我的设置和要求所特有的，但这应该让您了解如何前进...
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
我有一个问题让我很困惑。我正在尝试创建一个由 50 个问题组成的 Access 连续形式的考试。每个问题可以是选择题或 true/false。我很难弄清楚的问题是双重的：
- 如何让文本框显示问题，组合框将显示与该问题相关的适当答案选项？ （tblQuestions 有一个 ID 字段和问题，tblAnswerOptions 也有一个 ID 字段和一个 Test_Question_ID
即：ID=1，Test_Question_ID=1，答案=答案选项1； ID = 2，Test_Question_ID = 1，答案=答案选项2； ID = 3，Test_Question_ID = 1，答案 = 答案选项 3
- 如何获取访问权限以将应试者的下拉答案记录到由 ID、Student_ID、Test_Question_ID 和 Answer_ID 组成的 tblStudentAnswers 中？
我觉得有很多活动部件，我不确定从哪里开始 link 将它们全部放在一起。感谢任何 help/advice!
你有没有听过这个表达，"You can't get there from here."？
您的问题假设您的答案组合框与问题的形式相同。您需要做的实际上是拥有 3 个单独的表格。主表单将是 "test"，一个将显示问题的子表单 - 它可以是多个项目表单，因此用户可以滚动浏览问题，第三个表单 - 答案表单，用户将在其中select 他们的回答。
如果您希望能够一次显示所有问题供用户滚动浏览，则问题表单和答案表单都必须是测试表单的子表单，因此您必须编写一些vba 每次使用问题表单的 "on current" 事件更改问题表单时更新答案表单的代码。
您可以在答案表单中包含一个提交命令按钮，该按钮将检查他们答案中的值并将该值提交给 table。
你需要 3 种不同形式的原因是你的答案组合框的行源不断更新每个问题的不同答案，当你更新提出问题的形式上的组合框的行源时，您正在将多个项目表单中每个问题的每个组合框更新为仅对这个问题的答案。
Preliminary setup idea
我前段时间做过类似的事情。您可以在一个表单上完成，一个文本框和一个选项组，其中包含您对该问题有多少答案。我创建了几个查询，从可用问题列表中随机选择问题，然后一次将一个问题放在表单上，并以随机顺序添加答案。一旦学生选择了一个答案并点击下一步，他们的答案就会被记录下来，下一个问题和答案就会出现在屏幕上。
显然，这是我的设置和要求所特有的，但这应该让您了解如何前进...
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