课程签到管理系统-VBA代码
教师管理
Option Compare Database
Option Explicit
Private Sub Command清空_Click()
教师姓名.Value = ""
教师编号.Value = ""
性别.Value = ""
学院.Value = ""
职位.Value = ""
职务.Value = ""
联系方式.Value = ""
备注.Value = ""
End Sub
Private Sub Command全部_Click()
Me.数据表子窗体.Form.FilterOn = False
End Sub
Private Sub Command添加_Click()
On Error GoTo 添加失败错误
If 教师姓名 = "" Or IsNull(教师姓名) = True Then
MsgBox "教师姓名值为空！"
Exit Sub
End If
If 教师编号 = "" Or IsNull(教师编号) = True Then
MsgBox "教师编号值为空！"
Exit Sub
End If
If Nz(DCount("教师姓名", "教师表", "教师姓名='" & Me.教师姓名 & "'"), 0) > 0 Then
MsgBox "该教师姓名已存在！请输入其他教师姓名"
Exit Sub
End If
'================================================================
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("教师表", dbOpenTable)
With add_rs
.AddNew
!教师姓名.Value = 教师姓名.Value
!教师编号.Value = 教师编号.Value
!性别.Value = 性别.Value
!学院.Value = 学院.Value
!职位.Value = 职位.Value
!职务.Value = 职务.Value
!联系方式.Value = 联系方式.Value
!备注.Value = 备注.Value
.Update
.Close
End With
Set add_rs = Nothing
'================================================================
MsgBox "添加成功！"
Me.数据表子窗体.Requery
Exit Sub
添加失败错误:
MsgBox "添加失败！"
MsgBox Err.Description
End Sub
教师数据表
Option Compare Database
Option Explicit
Private Sub Form_BeforeUpdate(Cancel As Integer)
On Error GoTo 数据更新前提醒_Err
If (MsgBox("是否保存对记录的修改", 1, "修改记录提醒") = 1) Then
Beep
Else
DoCmd.RunCommand acCmdUndo
End If
数据更新前提醒_Exit:
Exit Sub
数据更新前提醒_Err:
MsgBox Error$
Resume 数据更新前提醒_Exit
End Sub
Private Sub 教师姓名_DblClick(Cancel As Integer)
DoCmd.OpenForm "教师信息更新删除", acNormal, , "教师姓名='" & 教师姓名 & "'"
End Sub
教师信息更新删除
Option Compare Database
Option Explicit
Private Sub Command保存_Click()
On Error Resume Next
DoCmd.RunCommand acCmdSaveRecord
If Error.Number <> 0 Then
MsgBox Error.Description
Else
MsgBox "保存成功"
End If
End Sub
Private Sub Command撤销_Click()
On Error Resume Next
DoCmd.RunCommand acCmdUndo
If Error.Number <> 0 Then
MsgBox Error.Description
End If
End Sub
Private Sub Command删除_Click()
On Error Resume Next
DoCmd.SetWarnings (False)
If MsgBox("是否删除该记录", vbOKCancel) = vbOK Then
DoCmd.RunCommand acCmdDeleteRecord
MsgBox "删除成功"
DoCmd.Close acForm, Me.Name
Else
Exit Sub
End If
If Error.Number <> 0 Then
MsgBox Error.Description
End If
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
On Error GoTo 数据更新前提醒_Err
If (MsgBox("是否保存对记录的修改", 1, "修改记录提醒") = 1) Then
Beep
Else
DoCmd.RunCommand acCmdUndo
End If
数据更新前提醒_Exit:
Exit Sub
数据更新前提醒_Err:
MsgBox Error$
Resume 数据更新前提醒_Exit
End Sub
Private Sub Form_Close()
Forms("教师管理").Form.数据表子窗体.Requery
End Sub
课程管理
Option Compare Database
Option Explicit
Private Sub Command清空_Click()
课程编号.Value = ""
课程名称.Value = ""
任课教师.Value = ""
上课地点.Value = ""
上课周数.Value = ""
上课时间.Value = ""
备注.Value = ""
End Sub
Private Sub Command全部_Click()
Me.数据表子窗体.Form.FilterOn = False
End Sub
Private Sub Command添加_Click()
On Error GoTo 添加失败错误
If 课程编号 = "" Or IsNull(课程编号) = True Then
MsgBox "课程编号值为空！"
Exit Sub
End If
If 课程名称 = "" Or IsNull(课程名称) = True Then
MsgBox "课程名称值为空！"
Exit Sub
End If
If 任课教师 = "" Or IsNull(任课教师) = True Then
MsgBox "任课教师值为空！"
Exit Sub
End If
If Nz(DCount("课程编号", "课程表", "课程编号='" & Me.课程编号 & "'"), 0) > 0 Then
MsgBox "该课程编号已存在！请输入其他课程编号"
Exit Sub
End If
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("课程表", dbOpenTable)
With add_rs
.AddNew
!课程编号.Value = 课程编号.Value
!课程名称.Value = 课程名称.Value
!任课教师.Value = 任课教师.Value
!上课地点.Value = 上课地点.Value
!上课周数.Value = 上课周数.Value
!上课时间.Value = 上课时间.Value
!备注.Value = 备注.Value
.Update
.Close
End With
Set add_rs = Nothing
MsgBox "添加成功！"
Me.数据表子窗体.Requery
Exit Sub
添加失败错误:
MsgBox "添加失败！"
MsgBox Err.Description
End Sub
课程签到情况
Option Compare Database
Option Explicit
Private Sub Command全部_Click()
Me.选择课程 = ""
Me.数据表子窗体.Form.FilterOn = False
Me.数据表子窗体2.Form.FilterOn = False
End Sub
Private Sub Command生成报表_Click()
If Me.选择课程 <> "" Then
DoCmd.OpenReport "课程签到情况报表", acViewReport, , "课程签到情况汇总统计查询_课程编号='" & Me.选择课程 & "'"
Else
DoCmd.OpenReport "课程签到情况报表", acViewReport
End If
End Sub
Private Sub 选择课程_Change()
Me.数据表子窗体.Form.Filter = "课程编号='" & Me.选择课程 & "'"
Me.数据表子窗体.Form.FilterOn = True
Me.数据表子窗体2.Form.Filter = "课程编号='" & Me.选择课程 & "'"
Me.数据表子窗体2.Form.FilterOn = True
End Sub
课程数据表
Option Compare Database
Option Explicit
Private Sub Form_BeforeUpdate(Cancel As Integer)
On Error GoTo 数据更新前提醒_Err
If (MsgBox("是否保存对记录的修改", 1, "修改记录提醒") = 1) Then
Beep
Else
DoCmd.RunCommand acCmdUndo
End If
数据更新前提醒_Exit:
Exit Sub
数据更新前提醒_Err:
MsgBox Error$
Resume 数据更新前提醒_Exit
End Sub
Private Sub 课程编号_DblClick(Cancel As Integer)
DoCmd.OpenForm "课程信息更新删除", acNormal, , "课程编号='" & 课程编号 & "'"
End Sub
课程信息更新删除
Option Compare Database
Option Explicit
Private Sub Command保存_Click()
On Error Resume Next
DoCmd.RunCommand acCmdSaveRecord
If Error.Number <> 0 Then
MsgBox Error.Description
Else
MsgBox "保存成功"
End If
End Sub
Private Sub Command撤销_Click()
On Error Resume Next
DoCmd.RunCommand acCmdUndo
If Error.Number <> 0 Then
MsgBox Error.Description
End If
End Sub
Private Sub Command删除_Click()
On Error Resume Next
DoCmd.SetWarnings (False)
If MsgBox("是否删除该记录", vbOKCancel) = vbOK Then
DoCmd.RunCommand acCmdDeleteRecord
MsgBox "删除成功"
DoCmd.Close acForm, Me.Name
Else
Exit Sub
End If
If Error.Number <> 0 Then
MsgBox Error.Description
End If
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
On Error GoTo 数据更新前提醒_Err
If (MsgBox("是否保存对记录的修改", 1, "修改记录提醒") = 1) Then
Beep
Else
DoCmd.RunCommand acCmdUndo
End If
数据更新前提醒_Exit:
Exit Sub
数据更新前提醒_Err:
MsgBox Error$
Resume 数据更新前提醒_Exit
End Sub
Private Sub Form_Close()
Forms("课程管理").Form.数据表子窗体.Requery
End Sub
签到管理
Option Compare Database
Option Explicit
Private Sub Command查询_Click()
Me.数据表子窗体.Form.Filter = "日期=#" & Me.日期 & "# and 课程编号='" & Me.选择课程 & "'"
Me.数据表子窗体.Form.FilterOn = True
Me.数据表子窗体.Requery
End Sub
Private Sub Command生成签到记录_Click()
If 日期 = "" Or IsNull(日期) = True Then
MsgBox "日期值为空！"
Exit Sub
End If
If 选择课程 = "" Or IsNull(选择课程) = True Then
MsgBox "选择课程值为空！"
Exit Sub
End If
If 上课时间 = "" Or IsNull(上课时间) = True Then
MsgBox "选择课程值为空！"
Exit Sub
End If
Dim search_rs As DAO.Recordset
Dim search_sql As String
search_sql = "Select * From 选课表 Where 课程编号='" & Me.选择课程 & "'"
Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset)
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("签到记录表", dbOpenTable)
With add_rs
Do While search_rs.EOF = False
'----------------------------------生成签到记录
.AddNew
!日期.Value = 日期.Value
!课程编号.Value = 选择课程
!学号.Value = search_rs!学号.Value
!上课时间.Value = 上课时间.Value
!迟到.Value = False
!早退.Value = False
!请假.Value = False
!旷课.Value = False
.Update
search_rs.MoveNext
Loop
.Close
End With
Set add_rs = Nothing
search_rs.Close
Set search_rs = Nothing
Me.数据表子窗体.Form.Filter = "日期=#" & Me.日期 & "# and 课程编号='" & Me.选择课程 & "'"
Me.数据表子窗体.Form.FilterOn = True
Me.数据表子窗体.Requery
End Sub
Private Sub Form_Load()
Me.日期 = Date
Me.上课时间 = Time
End Sub
签到记录查询数据表
Option Compare Database
Option Explicit
Private Sub 签到ID_DblClick(Cancel As Integer)
If MsgBox("是否删除该选课记录", vbOKCancel) = vbOK Then
DoCmd.SetWarnings (False)
Dim del_sql As String
del_sql = "Delete From 签到记录表 Where 签到ID=" & 签到ID
DoCmd.RunSQL del_sql
Forms("签到管理").数据表子窗体.Requery
End If
End Sub
Private Sub 签到时间_DblClick(Cancel As Integer)
Me.签到时间 = Time
End Sub
系统登录
Option Compare Database
Option Explicit
Private Sub 登录_Click()
If 账号 <> "" And 密码 <> "" Then
If Me.密码 = DLookup("密码", "账号密码表", "账号='" & Me.账号 & "'") Then '修改域函数参数
MsgBox "登录成功"
学生管理权限 = DLookup("学生管理", "账号密码表", "账号='" & Me.账号 & "'")
教师管理权限 = DLookup("教师管理", "账号密码表", "账号='" & Me.账号 & "'")
课程管理权限 = DLookup("课程管理", "账号密码表", "账号='" & Me.账号 & "'")
选课管理权限 = DLookup("选课管理", "账号密码表", "账号='" & Me.账号 & "'")
签到管理权限 = DLookup("签到管理", "账号密码表", "账号='" & Me.账号 & "'")
课程签到情况查询权限 = DLookup("课程签到情况查询", "账号密码表", "账号='" & Me.账号 & "'")
学生签到情况查询权限 = DLookup("学生签到情况查询", "账号密码表", "账号='" & Me.账号 & "'")
DoCmd.OpenForm "系统主页", acNormal, , "账号='" & Me.账号 & "'"
DoCmd.Close acForm, Me.Name
Else
MsgBox "账号或密码错误"
End If
Else
MsgBox "请输入账号和密码"
End If
End Sub
Private Sub 退出_Click()
Application.Quit
End Sub
系统主页
Option Compare Database
Option Explicit
Private Sub Command教师管理_Click()
If 教师管理权限 = True Then
DoCmd.OpenForm "教师管理", acNormal
Else
MsgBox "无权限"
Exit Sub
End If
End Sub
Private Sub Command课程管理_Click()
If 教师管理权限 = True Then
DoCmd.OpenForm "课程管理", acNormal
Else
MsgBox "无权限"
Exit Sub
End If
End Sub
Private Sub Command课程签到情况_Click()
If 课程签到情况查询权限 = True Then
DoCmd.OpenForm "课程签到情况", acNormal
Else
MsgBox "无权限"
Exit Sub
End If
End Sub
Private Sub Command签到管理_Click()
If 签到管理权限 = True Then
DoCmd.OpenForm "签到管理", acNormal
Else
MsgBox "无权限"
Exit Sub
End If
End Sub
Private Sub Command退出系统_Click()
Application.Quit acQuitSaveAll
End Sub
Private Sub Command选课管理_Click()
If 选课管理权限 = True Then
DoCmd.OpenForm "选课管理", acNormal
Else
MsgBox "无权限"
Exit Sub
End If
End Sub
Private Sub Command学生管理_Click()
If 学生管理权限 = True Then
DoCmd.OpenForm "学生管理", acNormal
Else
MsgBox "无权限"
Exit Sub
End If
End Sub
Private Sub Command学生签到情况_Click()
If 学生签到情况查询权限 = True Then
DoCmd.OpenForm "学生签到情况", acNormal
Else
MsgBox "无权限"
Exit Sub
End If
End Sub
选课管理
Option Compare Database
Option Explicit
Private Sub 选择课程_Change()
Me.Filter = "课程编号='" & Me.选择课程 & "'"
Me.FilterOn = True
'---------计算选课人数
Me.选课人数 = Nz(DCount("选课ID", "选课表", "课程编号='" & Me.课程编号 & "'"), 0)
End Sub
学生管理
Option Compare Database
Option Explicit
Private Sub Command清空_Click()
学号.Value = ""
姓名.Value = ""
性别.Value = ""
班级.Value = ""
专业.Value = ""
学院.Value = ""
联系方式.Value = ""
备注.Value = ""
End Sub
Private Sub Command全部_Click()
Me.数据表子窗体.Form.FilterOn = False
End Sub
Private Sub Command添加_Click()
On Error GoTo 添加失败错误
If 学号 = "" Or IsNull(学号) = True Then
MsgBox "学号值为空！"
Exit Sub
End If
If 姓名 = "" Or IsNull(姓名) = True Then
MsgBox "姓名值为空！"
Exit Sub
End If
If Nz(DCount("学号", "学生表", "学号='" & Me.学号 & "'"), 0) > 0 Then
MsgBox "该学号已存在！请添加其他学号"
Exit Sub
End If
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("学生表", dbOpenTable)
With add_rs
.AddNew
!学号.Value = 学号.Value
!姓名.Value = 姓名.Value
!性别.Value = 性别.Value
!班级.Value = 班级.Value
!专业.Value = 专业.Value
!学院.Value = 学院.Value
!联系方式.Value = 联系方式.Value
!备注.Value = 备注.Value
.Update
.Close
End With
Set add_rs = Nothing
MsgBox "添加成功！"
Me.数据表子窗体.Requery
Exit Sub
添加失败错误:
MsgBox "添加失败！"
MsgBox Err.Description
End Sub
学生签到情况
Option Compare Database
Option Explicit
Private Sub Command全部_Click()
Me.选择学生 = ""
Me.数据表子窗体.Form.FilterOn = False
Me.数据表子窗体2.Form.FilterOn = False
End Sub
Private Sub Command生成报表_Click()
If Me.选择学生 <> "" Then
DoCmd.OpenReport "学生签到情况报表", acViewReport, , "学号='" & Me.选择学生 & "'"
Else
DoCmd.OpenReport "学生签到情况报表", acViewReport
End If
End Sub
Private Sub 选择学生_Change()
Me.数据表子窗体.Form.Filter = "学号='" & Me.选择学生 & "'"
Me.数据表子窗体.Form.FilterOn = True
Me.数据表子窗体2.Form.Filter = "学号='" & Me.选择学生 & "'"
Me.数据表子窗体2.Form.FilterOn = True
End Sub
学生数据表
Option Compare Database
Option Explicit
Private Sub Form_BeforeUpdate(Cancel As Integer)
On Error GoTo 数据更新前提醒_Err
If (MsgBox("是否保存对记录的修改", 1, "修改记录提醒") = 1) Then
Beep
Else
DoCmd.RunCommand acCmdUndo
End If
数据更新前提醒_Exit:
Exit Sub
数据更新前提醒_Err:
MsgBox Error$
Resume 数据更新前提醒_Exit
End Sub
Private Sub 学号_DblClick(Cancel As Integer)
DoCmd.OpenForm "学生信息更新删除", acNormal, , "学号='" & 学号 & "'"
End Sub
学生数据表2
Option Compare Database
Option Explicit
Private Sub 学号_DblClick(Cancel As Integer)
If Nz(DCount("选课ID", "选课表", "课程编号='" & Forms("选课管理").课程编号 & "' and 学号='" & Me.学号 & "'"), 0) > 0 Then
MsgBox "该学生已选择该课程！请勿重复选择"
Exit Sub
Else
DoCmd.SetWarnings (False)
Dim add_sql As String
add_sql = "Insert Into 选课表 (课程编号,学号) Values ('" & Forms("选课管理").课程编号 & "','" & 学号 & "')"
DoCmd.RunSQL add_sql
Forms("选课管理").Form.数据表子窗体2.Requery
Forms("选课管理").选课人数 = Nz(DCount("选课ID", "选课表", "课程编号='" & Forms("选课管理").课程编号 & "'"), 0)
End If
End Sub
学生信息更新删除
Option Compare Database
Option Explicit
Private Sub Command保存_Click()
On Error Resume Next
DoCmd.RunCommand acCmdSaveRecord
If Error.Number <> 0 Then
MsgBox Error.Description
Else
MsgBox "保存成功"
End If
End Sub
Private Sub Command撤销_Click()
On Error Resume Next
DoCmd.RunCommand acCmdUndo
If Error.Number <> 0 Then
MsgBox Error.Description
End If
End Sub
Private Sub Command删除_Click()
On Error Resume Next
DoCmd.SetWarnings (False)
If MsgBox("是否删除该记录", vbOKCancel) = vbOK Then
DoCmd.RunCommand acCmdDeleteRecord
MsgBox "删除成功"
DoCmd.Close acForm, Me.Name
Else
Exit Sub
End If
If Error.Number <> 0 Then
MsgBox Error.Description
End If
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
On Error GoTo 数据更新前提醒_Err
If (MsgBox("是否保存对记录的修改", 1, "修改记录提醒") = 1) Then
Beep
Else
DoCmd.RunCommand acCmdUndo
End If
数据更新前提醒_Exit:
Exit Sub
数据更新前提醒_Err:
MsgBox Error$
Resume 数据更新前提醒_Exit
End Sub
Private Sub Form_Close()
Forms("学生管理").Form.数据表子窗体.Requery
End Sub
学生选课查询数据表
Option Compare Database
Option Explicit
Private Sub 选课ID_DblClick(Cancel As Integer)
If MsgBox("是否删除该选课记录", vbOKCancel) = vbOK Then
DoCmd.SetWarnings (False)
Dim del_sql As String
del_sql = "Delete From 选课表 Where 选课ID=" & 选课ID
DoCmd.RunSQL del_sql
Forms("选课管理").数据表子窗体2.Requery
Forms("选课管理").选课人数 = Nz(DCount("选课ID", "选课表", "课程编号='" & Forms("选课管理").课程编号 & "'"), 0)
End If
End Sub
模块1
Option Compare Database
Option Explicit
Public 学生管理权限 As Boolean
Public 教师管理权限 As Boolean
Public 课程管理权限 As Boolean
Public 选课管理权限 As Boolean
Public 签到管理权限 As Boolean
Public 课程签到情况查询权限 As Boolean
Public 学生签到情况查询权限 As Boolean
