設計資料
功能子產品圖
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