【问题标题】:How to test Multiple Conditions before a record is allowed in a Table?如何在表中允许记录之前测试多个条件?
【发布时间】:2017-04-20 10:15:42
【问题描述】:

以下是可获得的:

  1. 一年有 1 次会议

  2. 一个会话中有 3 个术语

  3. 学生将在学校学习 3 年。

  4. 一个学生在第 1 至第 3 年的 1 个学期中最多只能注册 9 个不同的科目。

  5. 学生将在另一个课程中被提升到另一个班级并提供相同的科目。 (我认为需要再次注册)

我已经拥有的东西

  1. 我有一个名为 tblEnrolled 的表,其中记录了注册。

  2. 我有一张注册表格

我希望在表格中允许记录之前满足以下条件:

  1. 没有学生可以在一个学期中注册超过 1 个特定学科(想检查所选学生是否已经在所选学期和所选课程中注册所选学科)

    李>
  2. 一个学期内任何学生都不能注册超过九 (9) 个不同的科目。

我真正想要什么?

我希望 SaveButton 的 On_Click 事件检查是否违反了上述任何条件。

感谢您的帮助。See the Enrollment Table for a Student, Please

编辑: 该代码仅检查主题是否已为特定学生注册。

Dim NewSubjectCode As String
Dim NewSubject As String
Dim stLinkCriteria As String
Dim strCriteria As String
Dim strMainCriteria As String
On Error GoTo Err

If IsNull(cboSession) Then
    MsgBox "Please select SESSION to proceed.", vbInformation, "Required"
    Me.cboSession.SetFocus
    Exit Sub
End If
If IsNull(cboTerm) Then
    MsgBox "Please select TERM to proceed.", vbInformation, "Required"
    Me.cboTerm.SetFocus
    Exit Sub
End If
If IsNull(cboSelectClass) Then
    MsgBox "Please select CLASS to proceed.", vbInformation, "Required"
    Me.cboSelectClass.SetFocus
    Exit Sub
End If
If IsNull(cboName) Then
    MsgBox "Please select STUDENT to proceed.", vbInformation, "Required"
    Me.cboName.SetFocus
    Exit Sub
End If
If IsNull(cboCode) Then
    MsgBox "Please select SUBJECT to proceed.", vbInformation, "Required"
    Me.cboCode.SetFocus
    Exit Sub
End If

NewSubject = Me.txtSubjects.Value
NewSubjectCode = Me.cboCode.Column(0)
NewStudentID = Me.txtStudentID.Value
stLinkCriteria = "[SubjectCode] = " & "'" & NewSubjectCode & "'"
strCriteria = "[StudentID] = " & "'" & NewStudentID & "'"
strMainCriteria = stLinkCriteria & "And" & strCriteria

If Me.cboCode.Column(0) = DLookup("[SubjectCode]", "QueryEnrollmentDetails", strMainCriteria) Then
    MsgBox "" & NewSubject & " is already selected for this student.", vbCritical, "Duplicate Subject"
    Me.Undo
    Me.cboCode.SetFocus
    Me.txtStudentID = Me.txtID
    Me.txtStudentName = Me.cboName
    Me.txtStudentClass = Me.txtClass
    Me.txtSession = Me.cboSession
    Me.txtTerm = Me.cboTerm
Exit Sub
Else
    DoCmd.RunCommand acCmdSaveRecord
    DoCmd.GoToRecord , , acNewRec
    Me.[SubformSubjects].Requery
    Me.cboCode.SetFocus
    Me.txtStudentID = Me.txtID
    Me.txtStudentName = Me.cboName
    Me.txtStudentClass = Me.txtClass
    Me.txtSession = Me.cboSession
    Me.txtTerm = Me.cboTerm
End If
Err:
Exit Sub
End Sub

非常感谢@David G

【问题讨论】:

  • 您可以通过多种方式实施此类限制/检查。你如何输入数据?这决定了需要实施检查的方式。您想使用 VBA/SQL/表定义吗?如果是这样,你有没有尝试过什么?如果是这样,请立即发布您的代码/尝试。
  • 感谢您的帮助。我想在 Access 中使用 VBA。我使用表单将数据输入到表格中。
  • 所以您希望在表单后面的 VBA 中进行一些检查。你做了一些研究吗?你试过任何代码吗?如果是这样,请将其发布在您的问题中。
  • 再次感谢 David G。请问如何在此处发布代码?我是新人。
  • 编辑您的问题(小的“编辑”按钮)并复制粘贴您的代码。然后选择您的代码并使用顶部功能区的“代码”按钮。

标签: vba ms-access criteria


【解决方案1】:

您的要求:

  1. 没有学生可以在一个学期中注册超过 1 个特定学科(想检查所选学生是否已经在所选学期和所选课程中注册了所选学科)

    李>
  2. 一个学期内任何学生都不能注册超过九 (9) 个不同的科目。

可以如下实现(仅大纲):

第一个可以实现为记录谁进入哪个学科的表的主键:学生和学科的组合是该表的主键,主键根据定义是唯一的。尝试再次插入该组合将被数据库拒绝。

第二个可以实现为"SELECT Count (*) FROM Subjects WHERE student= " & StudentName & "'",然后检查计数是否小于或等于9。

【讨论】:

  • 感谢您的帮助。但是,我不清楚您的建议。我的意思是,我有一个带有几个组合框的表格。我想检查我在这些组合框中的选择组合是否不会导致我的表中出现重复记录。因此,我需要在保存记录之前检查 VBA 代码。再次感谢
  • 如果您正确定义了表的主键,则不会导致重复条目!这就是 Primary Key 的全部概念——查找概念。尝试插入副本时保存将失败。
【解决方案2】:

谢谢大家。后来我通过使用 Multiple Criteria 检查是否存在此类记录来修复它。

保存按钮的On Click事件如下:

Private Sub cmdEnroll_Click()
Dim NewSubjectCode As String
Dim NewSubject As String
Dim strStudent As String
Dim strSubject As String
Dim strTerm As String
Dim strSession As String
Dim strClass As String
Dim StudentCheck As String
Dim SubjectCheck As String
Dim TermCheck As String
Dim SessionCheck As String
Dim SubjectCodeCheck As String
Dim strCriteria As String
Dim ClassCheck As String
On Error GoTo Err

If IsNull(cboSession) Then
    MsgBox "Please select Session to proceed.", vbExclamation, "Subjects Enrollment"
    Me.cboSession.SetFocus
    Exit Sub
End If
If IsNull(cboTerm) Then
    MsgBox "Please select Term to proceed.", vbExclamation, "Subjects Enrollment"
    Me.cboTerm.SetFocus
    Exit Sub
End If
If IsNull(cboSelectClass) Then
    MsgBox "Please select Class to proceed.", vbExclamation, "Subjects Enrollment"
    Me.cboSelectClass.SetFocus
    Exit Sub
End If
If IsNull(cboName) Then
    MsgBox "Please select Student to proceed.", vbExclamation, "Subjects Enrollment"
    Me.cboName.SetFocus
    Exit Sub
End If
If IsNull(cboCode) Then
    MsgBox "Please select Subject to proceed.", vbExclamation, "Subjects Enrollment"
    Me.cboCode.SetFocus
    Exit Sub
End If

SubjectCheck = Me.txtSubjects.Value
SubjectCodeCheck = Me.cboCode.Column(0)
StudentCheck = Me.txtStudentID.Value
TermCheck = Me.cboTerm.Value
SessionCheck = Me.cboSession.Value
ClassCheck = Me.cboSelectClass.Value
strSubject = "[SubjectCode] = " & "'" & SubjectCodeCheck & "'"
strStudent = "[StudentID] = " & "'" & StudentCheck & "'"
strTerm = "[Term] = " & "'" & TermCheck & "'"
strSession = "[Session] = " & "'" & SessionCheck & "'"
strClass = "[StudentClass] = " & "'" & ClassCheck & "'"

strCriteria = strStudent & "And" & strSubject & "And" & strTerm & "And" & strSession & "And" & strClass

If IsNull(DLookup("[StudentID]", "QueryEnrollmentDetails", strCriteria)) Then

    CurrentDb.Execute "INSERT INTO tblEnrolled(StudentID,StudentName,StudentClass,SubjectCode,SubjectName,Session,Term) " & _
        " VALUES('" & Me.txtID & "','" & Me.cboName & "','" & Me.cboSelectClass & "','" & _
        Me.cboCode & "','" & Me.txtSubjects & "','" & Me.cboSession & "','" & Me.cboTerm & "')"
    Me.[SubformSubjects].Requery
    Me.cboCode.SetFocus
    Me.txtStudentID = Me.txtID
    Me.txtStudentName = Me.cboName
    Me.txtStudentClass = Me.txtClass
    Me.txtSession = Me.cboSession
    Me.txtTerm = Me.cboTerm
Exit Sub
Else
    MsgBox "" & SubjectCheck & " is already selected for this student.", vbCritical, "Duplicate Subject"
    Me.Undo
    Me.cboCode.SetFocus
    Me.txtStudentID = Me.txtID
    Me.txtStudentName = Me.cboName
    Me.txtStudentClass = Me.txtClass
    Me.txtSession = Me.cboSession
    Me.txtTerm = Me.cboTerm

End If
Exit_Command:
    Exit Sub
Err:
    MsgBox Err.Description, vbCritical, "Error"
    Resume Exit_Command
End Sub

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2023-03-08
    • 2011-07-24
    • 1970-01-01
    • 2020-08-13
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多