学生通讯录管理系统 Access数据库系统 设计资料 VBA代码分享
设计资料
功能模块图
E-R图
VBA代码
系统主页
Private Sub Command参数设置_Click()
DoCmd.OpenForm "参数设置", acNormal
End Sub
Private Sub Command联系人查询_Click()
DoCmd.OpenForm "联系人查询", acNormal
End Sub
Private Sub Command联系人管理_Click()
DoCmd.OpenForm "联系人管理", acNormal
End Sub
Private Sub Command联系人添加_Click()
DoCmd.OpenForm "联系人添加", acNormal
End Sub
Private Sub Command退出系统_Click()
If MsgBox("是否退出该系统？", vbYesNo) = vbYes Then
Application.Quit acQuitSaveAll
End If
End Sub
Private Sub Command学生信息查询_Click()
DoCmd.OpenForm "学生信息查询", acNormal
End Sub
Private Sub Command学生信息管理_Click()
DoCmd.OpenForm "学生信息管理", acNormal
End Sub
Private Sub Command学生信息添加_Click()
DoCmd.OpenForm "学生信息添加", acNormal
End Sub
参数设置
Private Sub Form_Load()
DoCmd.SetWarnings (True)
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 Sub
数据更新前提醒_Err:
MsgBox Err.Description
End Sub
联系人查询
Private Sub Command查询_Click()
On Error GoTo 结束查询
Dim xs_filter As String
If Me.查询类型 = "日期" Then
If 起始日期 <> "" And IsNull(起始日期) = False And 截止日期 <> "" And IsNull(截止日期) = False And 查询类型 <> "" And IsNull(查询类型) = False Then
xs_filter = Me.查询类型 & " between #" & Me.起始日期 & "# and #" & Me.截止日期 & "#"
Me.数据表子窗体.Form.Filter = xs_filter
Me.数据表子窗体.Form.FilterOn = True
Me.数据表子窗体.Requery
Else
xs_filter = ""
Me.数据表子窗体.Form.FilterOn = False
Me.数据表子窗体.Requery
End If
Me.数据表子窗体.SetFocus
Exit Sub
End If
If Me.查询类型 = "数值" Then
If 最小 <> "" And IsNull(最小) = False And 最大 <> "" And IsNull(最大) = False And 查询类型 <> "" And IsNull(查询类型) = False Then
xs_filter = Me.查询类型 & " >= " & Me.最小 & " And " & Me.查询类型 & " <= " & Me.最大
Me.数据表子窗体.Form.Filter = xs_filter
Me.数据表子窗体.Form.FilterOn = True
Me.数据表子窗体.Requery
Else
xs_filter = ""
Me.数据表子窗体.Form.FilterOn = False
Me.数据表子窗体.Requery
End If
Me.数据表子窗体.SetFocus
Exit Sub
End If
If 查询内容 <> "" And IsNull(查询内容) = False And 查询类型 <> "" And IsNull(查询类型) = False Then
xs_filter = Me.查询类型 & " like '*" & Me.查询内容 & "*'"
Me.数据表子窗体.Form.Filter = xs_filter
Me.数据表子窗体.Form.FilterOn = True
Me.数据表子窗体.Requery
Else
xs_filter = ""
Me.数据表子窗体.Form.FilterOn = False
Me.数据表子窗体.Requery
End If
Me.数据表子窗体.SetFocus
Exit Sub
结束查询:
MsgBox Err.Description
End Sub
Private Sub Command全部_Click()
Me.数据表子窗体.Form.FilterOn = False
Me.数据表子窗体.Requery
End Sub
Private Sub Command生成报表_Click()
If Me.数据表子窗体.Form.FilterOn = False Then
DoCmd.OpenReport "联系人标签报表", acViewReport
Else
DoCmd.OpenReport "联系人标签报表", acViewReport, , Me.数据表子窗体.Form.Filter
End If
End Sub
Private Sub Command添加联系人_Click()
DoCmd.OpenForm "联系人添加", acNormal
End Sub
Private Sub Form_Load()
Me.查询内容.Visible = True
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = False
Me.最大.Visible = False
End Sub
Private Sub 查询类型_Change()
If Me.查询类型 = "日期" Then
Me.起始日期.Visible = True
Me.截止日期.Visible = True
Me.最小.Visible = False
Me.最大.Visible = False
Me.查询内容.Visible = False
Exit Sub
Else
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = False
Me.最大.Visible = False
Me.查询内容.Visible = True
End If
If Me.查询类型 = "数值" Then
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = True
Me.最大.Visible = True
Me.查询内容.Visible = False
Exit Sub
Else
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = False
Me.最大.Visible = False
Me.查询内容.Visible = True
End If
End Sub
联系人查询数据表
Private Sub 联系人ID_DblClick(Cancel As Integer)
DoCmd.OpenForm "联系人管理", acNormal, , "联系人ID=" & 联系人ID
End Sub
联系人管理
Private Sub Command更新_Click()
If 学号.Value <> "" And 联系人姓名.Value <> "" And 关系.Value <> "" And 联系人电话.Value <> "" Then
On Error Resume Next
DoCmd.RunCommand acCmdSaveRecord
Else
MsgBox "学号，联系人电话，关系，联系人姓名不能为空"
On Error Resume Next
DoCmd.RunCommand acCmdUndo
Exit Sub
End If
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("是否删除该联系人记录？", vbYesNo) = vbYes 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)
If 学号.Value <> "" And 联系人姓名.Value <> "" And 关系.Value <> "" And 联系人电话.Value <> "" Then
On Error GoTo 数据更新前提醒_Err
If (MsgBox("是否保存对记录的修改", 1, "修改记录提醒") = 1) Then
Beep
Else
DoCmd.RunCommand acCmdUndo
End If
Else
MsgBox "学号，联系人电话，关系，联系人姓名不能为空"
On Error Resume Next
DoCmd.RunCommand acCmdUndo
Exit Sub
End If
数据更新前提醒_Exit:
Exit Sub
数据更新前提醒_Err:
MsgBox Error$
Resume 数据更新前提醒_Exit
End Sub
Private Sub Form_Close()
On Error Resume Next
Forms("联系人查询").Form.数据表子窗体.Requery
End Sub
联系人添加
Private Sub Command清空_Click()
学号.Value = ""
联系人姓名.Value = ""
关系.Value = ""
联系人电话.Value = ""
其他联系方式.Value = ""
备注.Value = ""
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 联系人电话 = "" 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
.Update
.Close
End With
Set add_rs = Nothing
MsgBox "添加完成！"
Exit Sub
添加失败:
MsgBox Err.Description
End Sub
Private Sub Form_Close()
On Error Resume Next
Forms("联系人查询").Form.数据表子窗体.Requery
End Sub
学生信息查询
Private Sub Command查询_Click()
On Error GoTo 结束查询
Dim xs_filter As String
If Me.查询类型 = "出生日期" Then
If 起始日期 <> "" And IsNull(起始日期) = False And 截止日期 <> "" And IsNull(截止日期) = False And 查询类型 <> "" And IsNull(查询类型) = False Then
xs_filter = Me.查询类型 & " between #" & Me.起始日期 & "# and #" & Me.截止日期 & "#"
Me.数据表子窗体.Form.Filter = xs_filter
Me.数据表子窗体.Form.FilterOn = True
Me.数据表子窗体.Requery
Else
xs_filter = ""
Me.数据表子窗体.Form.FilterOn = False
Me.数据表子窗体.Requery
End If
Me.数据表子窗体.SetFocus
Exit Sub
End If
If Me.查询类型 = "年龄" Then
If 最小 <> "" And IsNull(最小) = False And 最大 <> "" And IsNull(最大) = False And 查询类型 <> "" And IsNull(查询类型) = False Then
xs_filter = Me.查询类型 & " >= " & Me.最小 & " And " & Me.查询类型 & " <= " & Me.最大
Me.数据表子窗体.Form.Filter = xs_filter
Me.数据表子窗体.Form.FilterOn = True
Me.数据表子窗体.Requery
Else
xs_filter = ""
Me.数据表子窗体.Form.FilterOn = False
Me.数据表子窗体.Requery
End If
Me.数据表子窗体.SetFocus
Exit Sub
End If
If 查询内容 <> "" And IsNull(查询内容) = False And 查询类型 <> "" And IsNull(查询类型) = False Then
xs_filter = Me.查询类型 & " like '*" & Me.查询内容 & "*'"
Me.数据表子窗体.Form.Filter = xs_filter
Me.数据表子窗体.Form.FilterOn = True
Me.数据表子窗体.Requery
Else
xs_filter = ""
Me.数据表子窗体.Form.FilterOn = False
Me.数据表子窗体.Requery
End If
Me.数据表子窗体.SetFocus
Exit Sub
结束查询:
MsgBox Err.Description
End Sub
Private Sub Command全部_Click()
Me.数据表子窗体.Form.FilterOn = False
Me.数据表子窗体.Requery
End Sub
Private Sub Command生成报表_Click()
If Me.数据表子窗体.Form.FilterOn = False Then
DoCmd.OpenReport "学生信息报表", acViewReport
Else
DoCmd.OpenReport "学生信息报表", acViewReport, , Me.数据表子窗体.Form.Filter
End If
End Sub
Private Sub Command添加学生_Click()
DoCmd.OpenForm "学生信息添加", acNormal
End Sub
Private Sub Form_Load()
Me.查询内容.Visible = True
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = False
Me.最大.Visible = False
End Sub
Private Sub 查询类型_Change()
If Me.查询类型 = "出生日期" Then
Me.起始日期.Visible = True
Me.截止日期.Visible = True
Me.最小.Visible = False
Me.最大.Visible = False
Me.查询内容.Visible = False
Exit Sub
Else
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = False
Me.最大.Visible = False
Me.查询内容.Visible = True
End If
If Me.查询类型 = "年龄" Then
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = True
Me.最大.Visible = True
Me.查询内容.Visible = False
Exit Sub
Else
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = False
Me.最大.Visible = False
Me.查询内容.Visible = True
End If
End Sub
学生信息查询数据表
Private Sub 学号_DblClick(Cancel As Integer)
DoCmd.OpenForm "学生信息管理", acNormal, , "学号='" & 学号 & "'"
End Sub
学生信息管理
Private Sub Command报表_Click()
DoCmd.OpenReport "学生联系人报表", acViewReport, , "学号='" & Me.学号 & "'"
End Sub
Private Sub Command更新_Click()
If 学号.Value <> "" And 姓名.Value <> "" And 性别.Value <> "" And 班级.Value <> "" And 专业.Value <> "" And 出生日期.Value <> "" And 家庭地址.Value <> "" Then
On Error Resume Next
DoCmd.RunCommand acCmdSaveRecord
Else
MsgBox "学号，姓名，性别，班级，专业，出生日期和家庭地址不能为空"
On Error Resume Next
DoCmd.RunCommand acCmdUndo
Exit Sub
End If
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("是否删除该学生信息？注意：删除学生信息后涉及该学生联系人也会被删除！", vbYesNo) = vbYes 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)
If 学号.Value <> "" And 姓名.Value <> "" And 性别.Value <> "" And 班级.Value <> "" And 专业.Value <> "" And 出生日期.Value <> "" And 家庭地址.Value <> "" Then
On Error GoTo 数据更新前提醒_Err
If (MsgBox("是否保存对记录的修改", 1, "修改记录提醒") = 1) Then
Beep
Else
DoCmd.RunCommand acCmdUndo
End If
Else
MsgBox "学号，姓名，性别，班级，专业，出生日期和家庭地址不能为空"
On Error Resume Next
DoCmd.RunCommand acCmdUndo
Exit Sub
End If
数据更新前提醒_Exit:
Exit Sub
数据更新前提醒_Err:
MsgBox Error$
Resume 数据更新前提醒_Exit
End Sub
Private Sub Form_Close()
On Error Resume Next
Forms("学生信息查询").Form.数据表子窗体.Requery
End Sub
学生信息添加
Private Sub Command清空_Click()
学号.Value = ""
姓名.Value = ""
性别.Value = ""
班级.Value = ""
专业.Value = ""
出生日期.Value = ""
家庭地址.Value = ""
备注.Value = ""
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 班级 = "" 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 家庭地址 = "" 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 "添加完成！"
Exit Sub
添加失败:
MsgBox Err.Description
End Sub
Private Sub Form_Close()
On Error Resume Next
Forms("学生信息查询").Form.数据表子窗体.Requery
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 Sub
数据更新前提醒_Err:
MsgBox Err.Description
End Sub
联系人标签报表
Private Sub Report_Load()
On Error Resume Next
If Forms("联系人查询").数据表子窗体.Form.OrderByOn = True Then
Me.OrderBy = Forms("联系人查询").数据表子窗体.Form.OrderBy
Me.OrderByOn = True
Else
Me.OrderByOn = False
End If
End Sub
学生信息报表
Private Sub Report_Load()
On Error Resume Next
If Forms("学生信息查询").数据表子窗体.Form.OrderByOn = True Then
Me.OrderBy = Forms("学生信息查询").数据表子窗体.Form.OrderBy
Me.OrderByOn = True
Else
Me.OrderByOn = False
End If
End Sub
