【學(xué)?？爝f管理系統(tǒng)】 Access數(shù)據(jù)庫(kù)管理系統(tǒng) VBA代碼分享
系統(tǒng)導(dǎo)航
Option Compare Database
Private Sub Command快遞查詢_Click()
DoCmd.OpenForm "快遞查詢", acNormal
End Sub
Private Sub Command快遞費(fèi)管理_Click()
DoCmd.OpenForm "快遞費(fèi)管理", 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()
DoCmd.OpenForm "收件管理", acNormal
End Sub
Private Sub Command收件添加_Click()
DoCmd.OpenForm "收件添加", acNormal
End Sub
Private Sub Command退出系統(tǒng)_Click()
If MsgBox("是否退出該系統(tǒng)？", vbYesNo) = vbYes Then
Application.Quit acQuitSaveAll
End If
End Sub
Private Sub Command學(xué)生管理_Click()
DoCmd.OpenForm "學(xué)生管理", 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報(bào)表_Click()
If Me.數(shù)據(jù)表子窗體.Form.FilterOn = False Then
DoCmd.OpenReport "寄件報(bào)表", acViewReport
Else
DoCmd.OpenReport "寄件報(bào)表", acViewReport, , Me.數(shù)據(jù)表子窗體.Form.Filter
End If
End Sub
Private Sub Command查詢_Click()
If Me.查詢類型 <> "" And Me.查詢內(nèi)容 <> "" Then
Me.數(shù)據(jù)表子窗體.Form.Filter = Me.查詢類型 & " like '*" & Me.查詢內(nèi)容 & "*'"
Me.數(shù)據(jù)表子窗體.Form.FilterOn = True
Else
Me.數(shù)據(jù)表子窗體.Form.FilterOn = False
End If
End Sub
Private Sub Command全部_Click()
Me.數(shù)據(jù)表子窗體.Form.FilterOn = False
End Sub
寄件查詢數(shù)據(jù)表
數(shù)據(jù)表形式窗體
Private Sub 寄件單號(hào)_DblClick(Cancel As Integer)
DoCmd.OpenForm "寄件管理", acNormal, , "寄件單號(hào)='" & Me.寄件單號(hào) & "'"
End Sub
寄件管理
文本框，組合框，按鈕，綁定記錄窗體
Private Sub Command更新_Click()
If 寄件單號(hào).Value <> "" And 快遞公司.Value <> "" And 收件地點(diǎn).Value <> "" And 收件人.Value <> "" And 收件地址.Value <> "" And 收件人聯(lián)系方式.Value <> "" And 寄件人.Value <> "" And 寄件地址.Value <> "" And 寄件人聯(lián)系方式.Value <> "" _
And 快遞單價(jià).Value <> "" And 快遞費(fèi).Value <> "" And 寄件學(xué)生.Value <> "" And 寄件時(shí)間.Value <> "" Then
On Error Resume Next
DoCmd.RunCommand acCmdSaveRecord
Else
MsgBox "寄件單號(hào)，快遞公司，收件地點(diǎn)，收件人，收件地址，收件人聯(lián)系方式，寄件人，寄件地址，寄件人聯(lián)系方式，快遞單價(jià)，快遞費(fèi)，寄件學(xué)生，寄件時(shí)間不能為空"
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 寄件單號(hào).Value <> "" And 快遞公司.Value <> "" And 收件地點(diǎn).Value <> "" And 收件人.Value <> "" And 收件地址.Value <> "" And 收件人聯(lián)系方式.Value <> "" And 寄件人.Value <> "" And 寄件地址.Value <> "" And 寄件人聯(lián)系方式.Value <> "" _
And 快遞單價(jià).Value <> "" And 快遞費(fèi).Value <> "" And 寄件學(xué)生.Value <> "" And 寄件時(shí)間.Value <> "" Then
On Error GoTo 數(shù)據(jù)更新前提醒_Err
If (MsgBox("是否保存對(duì)記錄的修改", 1, "修改記錄提醒") = 1) Then
Beep
Else
DoCmd.RunCommand acCmdUndo
End If
Else
MsgBox "快寄件單號(hào)，快遞公司，收件地點(diǎn)，收件人，收件地址，收件人聯(lián)系方式，寄件人，寄件地址，寄件人聯(lián)系方式，快遞單價(jià)，快遞費(fèi)，寄件學(xué)生，寄件時(shí)間不能為空"
On Error Resume Next
DoCmd.RunCommand acCmdUndo
Exit Sub
End If
數(shù)據(jù)更新前提醒_Exit:
Exit Sub
數(shù)據(jù)更新前提醒_Err:
MsgBox Error$
Resume 數(shù)據(jù)更新前提醒_Exit
End Sub
Private Sub Form_Close()
On Error Resume Next
Forms("寄件查詢").數(shù)據(jù)表子窗體.Form.Requery
End Sub
Private Sub Form_Load()
On Error Resume Next
Call 設(shè)置寄件物品(Me.寄件單號(hào))
End Sub
Private Sub 寄件時(shí)間_DblClick(Cancel As Integer)
Me.寄件時(shí)間.Value = Now
End Sub
Private Sub 快遞單價(jià)_AfterUpdate()
If Me.快遞單價(jià) <> "" And Me.快遞重量 <> "" Then
Me.快遞費(fèi) = CCur(Me.快遞單價(jià) * Me.快遞重量)
Else
Me.快遞費(fèi) = 0
End If
End Sub
Private Sub 快遞單價(jià)_Change()
If Me.快遞單價(jià) <> "" And Me.快遞重量 <> "" Then
Me.快遞費(fèi) = CCur(Me.快遞單價(jià) * Me.快遞重量)
Else
Me.快遞費(fèi) = 0
End If
End Sub
Private Sub 快遞重量_AfterUpdate()
If Me.快遞單價(jià) <> "" And Me.快遞重量 <> "" Then
Me.快遞費(fèi) = CCur(Me.快遞單價(jià) * Me.快遞重量)
Else
Me.快遞費(fèi) = 0
End If
End Sub
Private Sub 快遞重量_Change()
If Me.快遞單價(jià) <> "" And Me.快遞重量 <> "" Then
Me.快遞費(fèi) = CCur(Me.快遞單價(jià) * Me.快遞重量)
Else
Me.快遞費(fèi) = 0
End If
End Sub
Sub 設(shè)置寄件物品(ByVal jjdh As String)
Me.快遞物品.RowSource = "SELECT 快遞表.物品, 快遞表.物品類別, 快遞表.重量 FROM 快遞表 where 快遞單號(hào)='" & jjdh & "'"
Me.快遞物品.Requery
End Sub
寄件添加
文本框，組合框，按鈕
Private Sub Command快遞添加_Click()
DoCmd.OpenForm "快遞添加", acNormal
End Sub
Private Sub Command清空_Click()
寄件單號(hào).Value = ""
快遞公司.Value = ""
收件地點(diǎn).Value = ""
收件人.Value = ""
收件地址.Value = ""
收件人聯(lián)系方式.Value = ""
寄件人.Value = ""
寄件地址.Value = ""
寄件人聯(lián)系方式.Value = ""
快遞單價(jià).Value = ""
快遞費(fèi).Value = ""
寄件學(xué)生.Value = ""
寄件時(shí)間.Value = ""
備注說明.Value = ""
Me.快遞重量 = ""
Me.快遞物品 = ""
End Sub
Private Sub Command添加_Click()
If 寄件單號(hào) = "" Or IsNull(寄件單號(hào)) = True Then
MsgBox "寄件單號(hào)值為空！"
Exit Sub
End If
If 快遞公司 = "" Or IsNull(快遞公司) = True Then
MsgBox "快遞公司值為空！"
Exit Sub
End If
If 收件地點(diǎn) = "" Or IsNull(收件地點(diǎn)) = True Then
MsgBox "收件地點(diǎn)值為空！"
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 收件人聯(lián)系方式 = "" Or IsNull(收件人聯(lián)系方式) = True Then
MsgBox "收件人聯(lián)系方式值為空！"
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 寄件人聯(lián)系方式 = "" Or IsNull(寄件人聯(lián)系方式) = True Then
MsgBox "寄件人聯(lián)系方式值為空！"
Exit Sub
End If
If 快遞單價(jià) = "" Or IsNull(快遞單價(jià)) = True Then
MsgBox "快遞單價(jià)值為空！"
Exit Sub
End If
If 快遞費(fèi) = "" Or IsNull(快遞費(fèi)) = True Then
MsgBox "快遞費(fèi)值為空！"
Exit Sub
End If
If 寄件學(xué)生 = "" Or IsNull(寄件學(xué)生) = True Then
MsgBox "寄件學(xué)生值為空！"
Exit Sub
End If
If 寄件時(shí)間 = "" Or IsNull(寄件時(shí)間) = True Then
MsgBox "寄件時(shí)間值為空！"
Exit Sub
End If
If Nz(DCount("寄件單號(hào)", "寄件表", "寄件單號(hào)='" & Me.寄件單號(hào) & "'"), 0) > 0 Then
MsgBox "該寄件單號(hào)已存在！"
Exit Sub
End If
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("寄件表", dbOpenTable)
With add_rs
.AddNew
!寄件單號(hào).Value = 寄件單號(hào).Value
!快遞公司.Value = 快遞公司.Value
!收件地點(diǎn).Value = 收件地點(diǎn).Value
!收件人.Value = 收件人.Value
!收件地址.Value = 收件地址.Value
!收件人聯(lián)系方式.Value = 收件人聯(lián)系方式.Value
!寄件人.Value = 寄件人.Value
!寄件地址.Value = 寄件地址.Value
!寄件人聯(lián)系方式.Value = 寄件人聯(lián)系方式.Value
!快遞單價(jià).Value = 快遞單價(jià).Value
!快遞費(fèi).Value = 快遞費(fèi).Value
!寄件學(xué)生.Value = 寄件學(xué)生.Value
!寄件時(shí)間.Value = 寄件時(shí)間.Value
!備注說明.Value = 備注說明.Value
.Update
.Close
End With
Set add_rs = Nothing
MsgBox "添加完成"
Me.Requery
End Sub
Private Sub 寄件單號(hào)_AfterUpdate()
If Me.寄件單號(hào) <> "" Then
Me.快遞重量 = Nz(DSum("重量", "快遞表", "快遞單號(hào)='" & Me.寄件單號(hào) & "'"), 0)
Call 設(shè)置寄件物品(Me.寄件單號(hào))
Else
Me.快遞重量 = 0
End If
End Sub
Private Sub 寄件單號(hào)_Change()
If Me.寄件單號(hào) <> "" Then
Me.快遞重量 = Nz(DSum("重量", "快遞表", "快遞單號(hào)='" & Me.寄件單號(hào) & "'"), 0)
Call 設(shè)置寄件物品(Me.寄件單號(hào))
Else
Me.快遞重量 = 0
End If
End Sub
Private Sub 寄件時(shí)間_DblClick(Cancel As Integer)
Me.寄件時(shí)間.Value = Now
End Sub
Private Sub 快遞單價(jià)_AfterUpdate()
If Me.快遞單價(jià) <> "" And Me.快遞重量 <> "" Then
Me.快遞費(fèi) = CCur(Me.快遞單價(jià) * Me.快遞重量)
Else
Me.快遞費(fèi) = 0
End If
End Sub
Private Sub 快遞單價(jià)_Change()
If Me.快遞單價(jià) <> "" And Me.快遞重量 <> "" Then
Me.快遞費(fèi) = CCur(Me.快遞單價(jià) * Me.快遞重量)
Else
Me.快遞費(fèi) = 0
End If
End Sub
Private Sub 快遞公司_AfterUpdate()
If Me.快遞公司 <> "" And Me.收件地點(diǎn) <> "" Then
Me.快遞單價(jià) = Nz(DLookup("費(fèi)用單價(jià)", "快遞費(fèi)表", "快遞公司='" & Me.快遞公司 & "' and 目的地='" & Me.收件地點(diǎn) & "'"), 0)
Else
Me.快遞單價(jià) = 0
End If
If Me.快遞單價(jià) <> "" And Me.快遞重量 <> "" Then
Me.快遞費(fèi) = CCur(Me.快遞單價(jià) * Me.快遞重量)
Else
Me.快遞費(fèi) = 0
End If
End Sub
Private Sub 快遞公司_Change()
If Me.快遞公司 <> "" And Me.收件地點(diǎn) <> "" Then
Me.快遞單價(jià) = Nz(DLookup("費(fèi)用單價(jià)", "快遞費(fèi)表", "快遞公司='" & Me.快遞公司 & "' and 目的地='" & Me.收件地點(diǎn) & "'"), 0)
Else
Me.快遞單價(jià) = 0
End If
If Me.快遞單價(jià) <> "" And Me.快遞重量 <> "" Then
Me.快遞費(fèi) = CCur(Me.快遞單價(jià) * Me.快遞重量)
Else
Me.快遞費(fèi) = 0
End If
End Sub
Private Sub 快遞重量_AfterUpdate()
If Me.快遞單價(jià) <> "" And Me.快遞重量 <> "" Then
Me.快遞費(fèi) = CCur(Me.快遞單價(jià) * Me.快遞重量)
Else
Me.快遞費(fèi) = 0
End If
End Sub
Private Sub 快遞重量_Change()
If Me.快遞單價(jià) <> "" And Me.快遞重量 <> "" Then
Me.快遞費(fèi) = CCur(Me.快遞單價(jià) * Me.快遞重量)
Else
Me.快遞費(fèi) = 0
End If
End Sub
Private Sub 收件地點(diǎn)_AfterUpdate()
If Me.快遞公司 <> "" And Me.收件地點(diǎn) <> "" Then
Me.快遞單價(jià) = Nz(DLookup("費(fèi)用單價(jià)", "快遞費(fèi)表", "快遞公司='" & Me.快遞公司 & "' and 目的地='" & Me.收件地點(diǎn) & "'"), 0)
Else
Me.快遞單價(jià) = 0
End If
If Me.快遞單價(jià) <> "" And Me.快遞重量 <> "" Then
Me.快遞費(fèi) = CCur(Me.快遞單價(jià) * Me.快遞重量)
Else
Me.快遞費(fèi) = 0
End If
End Sub
Private Sub 收件地點(diǎn)_Change()
If Me.快遞公司 <> "" And Me.收件地點(diǎn) <> "" Then
Me.快遞單價(jià) = Nz(DLookup("費(fèi)用單價(jià)", "快遞費(fèi)表", "快遞公司='" & Me.快遞公司 & "' and 目的地='" & Me.收件地點(diǎn) & "'"), 0)
Else
Me.快遞單價(jià) = 0
End If
If Me.快遞單價(jià) <> "" And Me.快遞重量 <> "" Then
Me.快遞費(fèi) = CCur(Me.快遞單價(jià) * Me.快遞重量)
Else
Me.快遞費(fèi) = 0
End If
End Sub
Sub 設(shè)置寄件物品(ByVal jjdh As String)
Me.快遞物品.RowSource = "SELECT 快遞表.物品, 快遞表.物品類別, 快遞表.重量 FROM 快遞表 where 快遞單號(hào)='" & jjdh & "'"
Me.快遞物品.Requery
End Sub
快遞查詢
組合框，文本框，按鈕，子窗體
Private Sub Command報(bào)表_Click()
If Me.數(shù)據(jù)表子窗體.Form.FilterOn = False Then
DoCmd.OpenReport "快遞報(bào)表", acViewReport
Else
DoCmd.OpenReport "快遞報(bào)表", acViewReport, , Me.數(shù)據(jù)表子窗體.Form.Filter
End If
End Sub
Private Sub Command查詢_Click()
If Me.查詢類型 <> "" And Me.查詢內(nèi)容 <> "" Then
Me.數(shù)據(jù)表子窗體.Form.Filter = Me.查詢類型 & " like '*" & Me.查詢內(nèi)容 & "*'"
Me.數(shù)據(jù)表子窗體.Form.FilterOn = True
Else
Me.數(shù)據(jù)表子窗體.Form.FilterOn = False
End If
End Sub
Private Sub Command全部_Click()
Me.數(shù)據(jù)表子窗體.Form.FilterOn = False
End Sub
快遞費(fèi)管理
表格布局，文本框，組合框，按鈕
Private Sub Command保存_Click()
DoCmd.RunCommand acCmdSave
End Sub
Private Sub Command報(bào)表_Click()
DoCmd.OpenReport "快遞費(fèi)標(biāo)簽", acViewReport
End Sub
Private Sub Command清空_Click()
快遞公司添加.Value = ""
聯(lián)系電話添加.Value = ""
目的地添加.Value = ""
費(fèi)用單價(jià)添加.Value = ""
備注說明添加.Value = ""
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 費(fèi)用單價(jià)添加 = "" Or IsNull(費(fèi)用單價(jià)添加) = True Then
MsgBox "費(fèi)用單價(jià)值為空！"
Exit Sub
End If
DoCmd.SetWarnings (False)
Dim add_sql As String
add_sql = "Insert Into 快遞費(fèi)表 (快遞公司,聯(lián)系電話,目的地,費(fèi)用單價(jià),備注說明) Values ('" & 快遞公司添加 & "','" & 聯(lián)系電話添加 & "','" & 目的地添加 & "', " & 費(fèi)用單價(jià)添加 & " ,'" & 備注說明添加 & "')"
DoCmd.RunSQL add_sql
MsgBox "添加完成"
Me.Requery
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
If 快遞公司.Value <> "" And 目的地.Value <> "" And 費(fèi)用單價(jià).Value <> "" Then
On Error GoTo 數(shù)據(jù)更新前提醒_Err
If (MsgBox("是否保存對(duì)記錄的修改", 1, "修改記錄提醒") = 1) Then
Beep
Else
DoCmd.RunCommand acCmdUndo
End If
Else
MsgBox "學(xué)號(hào)，姓名不能為空"
On Error Resume Next
DoCmd.RunCommand acCmdUndo
Exit Sub
End If
數(shù)據(jù)更新前提醒_Exit:
Exit Sub
數(shù)據(jù)更新前提醒_Err:
MsgBox Error$
Resume 數(shù)據(jù)更新前提醒_Exit
End Sub
Private Sub 快遞費(fèi)ID_DblClick(Cancel As Integer)
If MsgBox("是否刪除該快遞費(fèi)記錄：" & Me.快遞費(fèi)ID & " ?", vbYesNo) = vbYes Then
DoCmd.SetWarnings (False)
DoCmd.OpenQuery "快遞費(fèi)刪除查詢", acViewNormal
MsgBox "刪除完成"
Me.Requery
End If
End Sub
快遞管理
組合框，文本框，按鈕，綁定記錄窗體，附件
Private Sub Command更新_Click()
If 快遞類型.Value <> "" And 快遞單號(hào).Value <> "" And 物品.Value <> "" And 物品類別.Value <> "" And 重量.Value <> "" Then
On Error Resume Next
DoCmd.RunCommand acCmdSaveRecord
Else
MsgBox "快遞類型，快遞單號(hào)，物品，物品類別，重量不能為空"
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 快遞單號(hào).Value <> "" And 物品.Value <> "" And 物品類別.Value <> "" And 重量.Value <> "" Then
On Error GoTo 數(shù)據(jù)更新前提醒_Err
If (MsgBox("是否保存對(duì)記錄的修改", 1, "修改記錄提醒") = 1) Then
Beep
Else
DoCmd.RunCommand acCmdUndo
End If
Else
MsgBox "快遞類型，快遞單號(hào)，物品，物品類別，重量不能為空"
On Error Resume Next
DoCmd.RunCommand acCmdUndo
Exit Sub
End If
數(shù)據(jù)更新前提醒_Exit:
Exit Sub
數(shù)據(jù)更新前提醒_Err:
MsgBox Error$
Resume 數(shù)據(jù)更新前提醒_Exit
End Sub
Private Sub Form_Close()
On Error Resume Next
Forms("快遞查詢").數(shù)據(jù)表子窗體.Form.Requery
End Sub
快遞數(shù)據(jù)表
數(shù)據(jù)表形式窗體
Private Sub 快遞ID_DblClick(Cancel As Integer)
DoCmd.OpenForm "快遞管理", acNormal, , "快遞ID=" & Me.快遞ID
End Sub
快遞添加
文本框，組合框，按鈕
Private Sub Command清空_Click()
快遞類型.Value = ""
快遞單號(hào).Value = ""
物品.Value = ""
物品類別.Value = ""
重量.Value = ""
備注說明.Value = ""
存放位置.Value = ""
End Sub
Private Sub Command添加_Click()
If 快遞類型 = "" Or IsNull(快遞類型) = True Then
MsgBox "快遞類型值為空！"
Exit Sub
End If
If 快遞單號(hào) = "" Or IsNull(快遞單號(hào)) = True Then
MsgBox "快遞單號(hào)值為空！"
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
DoCmd.SetWarnings (False)
DoCmd.OpenQuery "快遞添加查詢", acViewNormal
If MsgBox("添加完成，是否打開快遞管理窗體", vbYesNo) = vbYes Then
DoCmd.OpenForm "快遞管理", acNormal, , "快遞ID=" & Nz(DMax("快遞ID", "快遞表"), 0)
End If
Me.Requery
End Sub
收件查詢
組合框，文本框，按鈕，子窗體
Private Sub Command報(bào)表_Click()
If Me.數(shù)據(jù)表子窗體.Form.FilterOn = False Then
DoCmd.OpenReport "收件報(bào)表", acViewReport
Else
DoCmd.OpenReport "收件報(bào)表", acViewReport, , Me.數(shù)據(jù)表子窗體.Form.Filter
End If
End Sub
Private Sub Command查詢_Click()
If Me.查詢類型 <> "" And Me.查詢內(nèi)容 <> "" Then
Me.數(shù)據(jù)表子窗體.Form.Filter = Me.查詢類型 & " like '*" & Me.查詢內(nèi)容 & "*'"
Me.數(shù)據(jù)表子窗體.Form.FilterOn = True
Else
Me.數(shù)據(jù)表子窗體.Form.FilterOn = False
End If
End Sub
Private Sub Command全部_Click()
Me.數(shù)據(jù)表子窗體.Form.FilterOn = False
End Sub
收件查詢數(shù)據(jù)表
數(shù)據(jù)表形式窗體
Private Sub 收件單號(hào)_DblClick(Cancel As Integer)
DoCmd.OpenForm "收件管理", acNormal, , "收件單號(hào)='" & Me.收件單號(hào) & "'"
End Sub
收件管理
文本框，組合框，按鈕，復(fù)選框，綁定記錄窗體
Private Sub Command更新_Click()
If 收件單號(hào).Value <> "" And 快遞公司.Value <> "" And 寄件地點(diǎn).Value <> "" And 收件人.Value <> "" And 收件地址.Value <> "" And 收件人聯(lián)系方式.Value <> "" _
And 取件學(xué)生.Value <> "" And 取件類型.Value <> "" And 收件日期.Value <> "" And 取件時(shí)間.Value <> "" Then
On Error Resume Next
DoCmd.RunCommand acCmdSaveRecord
Else
MsgBox "快遞類型，快遞單號(hào)，物品，物品類別，重量不能為空"
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 收件單號(hào).Value <> "" And 快遞公司.Value <> "" And 寄件地點(diǎn).Value <> "" And 收件人.Value <> "" And 收件地址.Value <> "" And 收件人聯(lián)系方式.Value <> "" _
And 取件學(xué)生.Value <> "" And 取件類型.Value <> "" And 收件日期.Value <> "" And 取件時(shí)間.Value <> "" Then
On Error GoTo 數(shù)據(jù)更新前提醒_Err
If (MsgBox("是否保存對(duì)記錄的修改", 1, "修改記錄提醒") = 1) Then
Beep
Else
DoCmd.RunCommand acCmdUndo
End If
Else
MsgBox "收件單號(hào)，快遞公司，寄件地點(diǎn)，收件人，收件地址，收件人聯(lián)系方式，取件學(xué)生，取件類型，收件日期，取件時(shí)間不能為空"
On Error Resume Next
DoCmd.RunCommand acCmdUndo
Exit Sub
End If
數(shù)據(jù)更新前提醒_Exit:
Exit Sub
數(shù)據(jù)更新前提醒_Err:
MsgBox Error$
Resume 數(shù)據(jù)更新前提醒_Exit
End Sub
Private Sub Form_Close()
On Error Resume Next
Forms("收件查詢").數(shù)據(jù)表子窗體.Form.Requery
End Sub
收件添加
文本框，組合框，按鈕，復(fù)選框
Private Sub Command清空_Click()
收件單號(hào).Value = ""
快遞公司.Value = ""
寄件地點(diǎn).Value = ""
收件人.Value = ""
收件地址.Value = ""
收件人聯(lián)系方式.Value = ""
寄件人.Value = ""
寄件地址.Value = ""
寄件人聯(lián)系方式.Value = ""
取件學(xué)生.Value = ""
取件人聯(lián)系方式.Value = ""
取件類型.Value = ""
收件日期.Value = ""
取件時(shí)間.Value = ""
是否已取件.Value = False
備注說明.Value = ""
End Sub
Private Sub Command添加_Click()
If 收件單號(hào) = "" Or IsNull(收件單號(hào)) = True Then
MsgBox "收件單號(hào)值為空！"
Exit Sub
End If
If 快遞公司 = "" Or IsNull(快遞公司) = True Then
MsgBox "快遞公司值為空！"
Exit Sub
End If
If 寄件地點(diǎn) = "" Or IsNull(寄件地點(diǎn)) = True Then
MsgBox "寄件地點(diǎn)值為空！"
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 收件人聯(lián)系方式 = "" Or IsNull(收件人聯(lián)系方式) = True Then
MsgBox "收件人聯(lián)系方式值為空！"
Exit Sub
End If
If 取件學(xué)生 = "" Or IsNull(取件學(xué)生) = True Then
MsgBox "取件學(xué)生值為空！"
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 取件時(shí)間 = "" Or IsNull(取件時(shí)間) = True Then
MsgBox "取件時(shí)間值為空！"
Exit Sub
End If
If Nz(DCount("收件單號(hào)", "收件表", "收件單號(hào)='" & Me.收件單號(hào) & "'"), 0) > 0 Then
MsgBox "該收件單號(hào)已存在！"
Exit Sub
End If
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("收件表", dbOpenTable)
With add_rs
.AddNew
!收件單號(hào).Value = 收件單號(hào).Value
!快遞公司.Value = 快遞公司.Value
!寄件地點(diǎn).Value = 寄件地點(diǎn).Value
!收件人.Value = 收件人.Value
!收件地址.Value = 收件地址.Value
!收件人聯(lián)系方式.Value = 收件人聯(lián)系方式.Value
!寄件人.Value = 寄件人.Value
!寄件地址.Value = 寄件地址.Value
!寄件人聯(lián)系方式.Value = 寄件人聯(lián)系方式.Value
!取件學(xué)生.Value = 取件學(xué)生.Value
!取件人聯(lián)系方式.Value = 取件人聯(lián)系方式.Value
!取件類型.Value = 取件類型.Value
!收件日期.Value = 收件日期.Value
!取件時(shí)間.Value = 取件時(shí)間.Value
!是否已取件.Value = 是否已取件.Value
!備注說明.Value = 備注說明.Value
.Update
.Close
End With
Set add_rs = Nothing
MsgBox "添加完成"
Me.Requery
End Sub
Private Sub Form_Load()
Me.是否已取件.Value = False
End Sub
Private Sub 取件時(shí)間_DblClick(Cancel As Integer)
Me.取件時(shí)間.Value = Now
End Sub
Private Sub 取件學(xué)生_AfterUpdate()
If Me.取件學(xué)生 <> "" Then
Me.取件人聯(lián)系方式 = Nz(DLookup("聯(lián)系方式", "學(xué)生表", "學(xué)號(hào)='" & Me.取件學(xué)生 & "'"), "")
Else
Me.取件人聯(lián)系方式 = ""
End If
End Sub
Private Sub 取件學(xué)生_Change()
If Me.取件學(xué)生 <> "" Then
Me.取件人聯(lián)系方式 = Nz(DLookup("聯(lián)系方式", "學(xué)生表", "學(xué)號(hào)='" & Me.取件學(xué)生 & "'"), "")
Else
Me.取件人聯(lián)系方式 = ""
End If
End Sub
Private Sub 收件日期_DblClick(Cancel As Integer)
Me.收件日期.Value = Date
End Sub
學(xué)生管理
表格布局，文本框，組合框，按鈕
Private Sub Command保存_Click()
DoCmd.RunCommand acCmdSave
End Sub
Private Sub Command清空_Click()
學(xué)號(hào)添加.Value = ""
姓名添加.Value = ""
性別添加.Value = ""
班級(jí)添加.Value = ""
專業(yè)添加.Value = ""
宿舍添加.Value = ""
聯(lián)系方式添加.Value = ""
End Sub
Private Sub Command添加_Click()
If 學(xué)號(hào)添加 = "" Or IsNull(學(xué)號(hào)添加) = True Then
MsgBox "學(xué)號(hào)值為空！"
Exit Sub
End If
If 姓名添加 = "" Or IsNull(姓名添加) = True Then
MsgBox "姓名值為空！"
Exit Sub
End If
DoCmd.SetWarnings (False)
Dim add_sql As String
add_sql = "Insert Into 學(xué)生表 (學(xué)號(hào),姓名,性別,班級(jí),專業(yè),宿舍,聯(lián)系方式) Values ('" & 學(xué)號(hào)添加 & "','" & 姓名添加 & "','" & 性別添加 & "','" & 班級(jí)添加 & "','" & 專業(yè)添加 & "','" & 宿舍添加 & "','" & 聯(lián)系方式添加 & "')"
DoCmd.RunSQL add_sql
MsgBox "添加完成"
Me.Requery
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
If 學(xué)號(hào).Value <> "" And 姓名.Value <> "" Then
On Error GoTo 數(shù)據(jù)更新前提醒_Err
If (MsgBox("是否保存對(duì)記錄的修改", 1, "修改記錄提醒") = 1) Then
Beep
Else
DoCmd.RunCommand acCmdUndo
End If
Else
MsgBox "學(xué)號(hào)，姓名不能為空"
On Error Resume Next
DoCmd.RunCommand acCmdUndo
Exit Sub
End If
數(shù)據(jù)更新前提醒_Exit:
Exit Sub
數(shù)據(jù)更新前提醒_Err:
MsgBox Error$
Resume 數(shù)據(jù)更新前提醒_Exit
End Sub
Private Sub 學(xué)號(hào)_DblClick(Cancel As Integer)
If MsgBox("是否刪除該學(xué)生記錄：" & Me.學(xué)號(hào) & " ?", vbYesNo) = vbYes Then
DoCmd.SetWarnings (False)
DoCmd.OpenQuery "學(xué)生刪除查詢", acViewNormal
MsgBox "刪除完成"
Me.Requery
End If
End Sub
