【學(xué)校收費(fèi)管理系統(tǒng)】VB系統(tǒng)設(shè)計(jì)資料和示例代碼
功能模塊圖
業(yè)務(wù)流程圖
數(shù)據(jù)流圖
ER圖
關(guān)系模型
考試費(fèi)（考試名稱，學(xué)號(hào)，考試費(fèi)，已收金額，未交金額，交費(fèi)日期，備注）
教材費(fèi)（教材名稱，學(xué)號(hào)，教材費(fèi)，已收金額，未交金額，交費(fèi)日期，備注）
學(xué)費(fèi)（學(xué)期，學(xué)號(hào)，學(xué)費(fèi)，已收金額，未交金額，交費(fèi)日期，備注）
學(xué)生信息表（學(xué)號(hào)，姓名，性別，班級(jí)，學(xué)院，聯(lián)系方式）
其他費(fèi)表（費(fèi)用名稱，學(xué)號(hào)，其他費(fèi)，已收金額，未交金額，交費(fèi)日期，備注）
住宿費(fèi)表（宿舍名稱，住宿時(shí)間，學(xué)號(hào)，住宿費(fèi)，已收金額，未交金額，交費(fèi)日期，備注）
程序流程圖
Access數(shù)據(jù)庫(kù)
表
考試費(fèi)表
考試表
班級(jí)表
教材費(fèi)表
教材表
宿舍表
學(xué)費(fèi)表
學(xué)生信息表
學(xué)期表
其他費(fèi)表??????
住宿費(fèi)表
賬戶表
表關(guān)系
查詢
教材費(fèi)查詢
考試費(fèi)查詢
;
其他費(fèi)查詢
學(xué)費(fèi)查詢
學(xué)生教材費(fèi)查詢
學(xué)生考試費(fèi)查詢
學(xué)生其他費(fèi)查詢
學(xué)生信息查詢
學(xué)生學(xué)費(fèi)查詢
學(xué)生住宿費(fèi)查詢
住宿費(fèi)查詢
示例模塊（學(xué)費(fèi)管理）
學(xué)費(fèi)添加
Dim dh As Long? '存儲(chǔ)高度差
Dim dw As Long? '存儲(chǔ)寬度差
Private Sub Text_DblClick(Index As Integer)
If Index = 0 Then
?? xf_formname = "frm學(xué)費(fèi)添加"
?? frm學(xué)期選擇.Show 1
End If
If Index = 1 Then
?? student_formname = "frm學(xué)費(fèi)添加"
?? frm學(xué)生選擇.Show 1
End If
If Index = 5 Then?????? '雙擊輸入日期的文本框
?? If Text(5) <> "" Then
????? DTPicker1.Value = Text(5)
?? Else
?? Text(5) = Date
?? DTPicker1.Value = Date
?? End If
?? DTPicker1.Visible = True???? '顯示日期選擇控件
End If
End Sub
Private Sub Command清空_Click()
Text(0).Text = ""
Text(1).Text = ""
Text(2).Text = ""
Text(3).Text = ""
Text(4).Text = ""
Text(5).Text = ""
DTPicker1.Visible = False?????? '日期控件隱藏
End Sub
Private Sub Command添加_Click()
On Error GoTo 錯(cuò)誤提示
If 學(xué)費(fèi)添加權(quán)限 = False Then
MsgBox "無(wú)權(quán)限"
Exit Sub
End If
'判斷必須輸入數(shù)據(jù)的控件不能為空
If Text(0) = "" Or IsNull(Text(0)) = True Then
MsgBox "學(xué)期值不能為空！"
Exit Sub
Else
End If
If Text(1) = "" Or IsNull(Text(1)) = True Then
MsgBox "學(xué)號(hào)值不能為空！"
Exit Sub
Else
End If
If Text(2) = "" Or IsNull(Text(2)) = True Then
MsgBox "學(xué)費(fèi)值不能為空！"
Exit Sub
Else
End If
If Text(3) = "" Or IsNull(Text(3)) = True Then
MsgBox "已收金額不能為空！"
Exit Sub
Else
End If
'檢查學(xué)號(hào)是否已存在
??? If dcountlink("學(xué)號(hào)", "學(xué)生信息表", "學(xué)號(hào)='" & Text(1) & "'", 0) = 0 Then
??? MsgBox "該學(xué)號(hào)不存在，請(qǐng)修改后重試"
??? Exit Sub
??? End If
Dim add_conn As New ADODB.Connection
Dim add_rs As New ADODB.Recordset
With add_conn
??? .ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "\db_xxsf.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"
??? .Open
End With
?????? add_rs.Open "學(xué)費(fèi)表", add_conn, adOpenKeyset, adLockOptimistic
?????? add_rs.AddNew
'?????? On Error Resume Next
?? ?????????add_rs!學(xué)期.Value = Text(0).Text
??????????? add_rs!學(xué)號(hào).Value = Text(1).Text
??????????? add_rs!學(xué)費(fèi).Value = Text(2).Text
??????????? add_rs!已收金額.Value = Text(3).Text
??????????? add_rs!備注.Value = Text(4).Text
??????????? add_rs!交費(fèi)日期.Value = Text(5).Text
?????? add_rs.Update
?????? add_rs.Clone
?????? Set add_rs = Nothing
?????? add_conn.Close
?????? Set add_conn = Nothing
?????? MsgBox "添加完成"
?????? Call Command清空_Click
?????? Adodc1.Refresh
?????? DataGrid1.Refresh
Exit Sub
錯(cuò)誤提示:
MsgBox Err.Description
End Sub
Private Sub Form_Load()
'ado控件設(shè)置
Me.Adodc1.CommandType = adCmdUnknown
Me.Adodc1.RecordSource = "select * From 學(xué)費(fèi)表 Order By 學(xué)費(fèi)ID DESC"
Me.Adodc1.Refresh??? '刷新
'存儲(chǔ)數(shù)據(jù)表格控件與窗體寬高差值
dh = Me.Height - DataGrid1.Height
dw = Me.Width - DataGrid1.Width
End Sub
Private Sub Form_Resize()
'窗體大小變化表格控件尺寸改變
If Me.WindowState <> 1 Then
DataGrid1.Height = Me.Height - dh
DataGrid1.Width = Me.Width - dw
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
frm學(xué)費(fèi)查詢.Adodc1.Refresh
frm學(xué)費(fèi)查詢.DataGrid1.Refresh
End Sub
Private Sub DTPicker1_LostFocus()
DTPicker1.Format = dtpCustom??? '日期格式設(shè)置
Text(5).Text = DTPicker1.Value? '返回選擇的日期值至文本框
DTPicker1.Visible = False?????? '日期控件隱藏
End Sub
?
?
Private Sub Text_LostFocus(Index As Integer)
If Index = 5 Then?????? '輸入日期的文本框失去焦點(diǎn)
?? If Text(5).Text <> "" And IsDate(Text(5)) = False Then
????? MsgBox "輸入的數(shù)據(jù)不是日期類型，請(qǐng)重新輸入"
????? Text(5).Text = ""
????? DTPicker1.Value = False
????? Exit Sub
?? End If
End If
If Index = 2 Then?? ????'輸入貨幣格式的文本框失去焦點(diǎn)
?? If Text(2).Text <> "" And IsNumeric(Text(2)) = False Then
????? MsgBox "輸入的數(shù)據(jù)不是貨幣類型，請(qǐng)重新輸入"
????? Text(2).Text = ""
????? Exit Sub
?? End If
End If
If Index = 3 Then?????? '輸入貨幣格式的文本框失去焦點(diǎn)
?? If Text(3).Text <> "" And IsNumeric(Text(3)) = False Then
????? MsgBox "輸入的數(shù)據(jù)不是貨幣類型，請(qǐng)重新輸入"
????? Text(3).Text = ""
????? Exit Sub
?? End If
End If
End Sub
學(xué)費(fèi)查詢
Dim dh As Long? '存儲(chǔ)高度差
Dim dw As Long? '存儲(chǔ)寬度差
Private Sub Command查詢1_Click()??? '單條件查詢
On Error GoTo 結(jié)束查詢
Dim search_field As String
If 查詢字段 = "交費(fèi)日期" Then
?
??? If 起始日期 <> "" And IsNull(起始日期) = False And 截止日期 <> "" And IsNull(截止日期) = False And 查詢字段 <> "" And IsNull(查詢字段) = False Then
??????? search_field = 查詢字段
??????? xf_filter = search_field & " between #" & 起始日期 & "# and #" & 截止日期 & "#"
??? Else
??????? xf_filter = ""
??? End If
??? Adodc1.RecordSource = 生成查詢語(yǔ)句("學(xué)費(fèi)查詢", xf_filter, xf_order)
??? Adodc1.Refresh
??? DataGrid1.Refresh
??? DataGrid1.SetFocus
??? Exit Sub
End If
If 查詢字段 = "學(xué)費(fèi)" Or 查詢字段 = "已收金額" Or 查詢字段 = "未交金額" Then
??? If 最小 <> "" And IsNull(最小) = False And 最大 <> "" And IsNull(最大) = False And 查詢字段 <> "" And IsNull(查詢字段) = False Then
??????? search_field = 查詢字段
??????? xf_filter = search_field & " >= " & 最小 & " And " & search_field & " <= " & 最大
??? Else
??????? xf_filter = ""
??? End If
??? Adodc1.RecordSource = 生成查詢語(yǔ)句("學(xué)費(fèi)查詢", xf_filter, xf_order)
??? Adodc1.Refresh
??? DataGrid1.Refresh
??? DataGrid1.SetFocus
??? Exit Sub
End If
?
If 查詢內(nèi)容 <> "" And IsNull(查詢內(nèi)容) = False And 查詢字段 <> "" And IsNull(查詢字段) = False Then
??? search_field = 查詢字段
??? xf_filter = search_field & " like '%" & 查詢內(nèi)容 & "%'"
Else
??? xf_filter = ""
End If
??? Adodc1.RecordSource = 生成查詢語(yǔ)句("學(xué)費(fèi)查詢", xf_filter, xf_order)
??? Adodc1.Refresh
??? DataGrid1.Refresh
??? DataGrid1.SetFocus
??? Exit Sub
結(jié)束查詢:
??? MsgBox Err.Description
End Sub
?
Private Sub Command管理_Click()
On Error GoTo A1
xf_num = DataGrid1.Columns(0).Text
frm學(xué)費(fèi)管理.Show 1
A1:
End Sub
?
Private Sub Command降序_Click()
If 排序 <> "" And IsNull(排序) = False Then
xf_order = 排序 & " DESC"
Else
xf_order = ""
End If
Adodc1.RecordSource = 生成查詢語(yǔ)句("學(xué)費(fèi)查詢", xf_filter, xf_order)
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
End Sub
?
Private Sub Command全部_Click()
xf_filter = ""
Adodc1.RecordSource = 生成查詢語(yǔ)句("學(xué)費(fèi)查詢", xf_filter, xf_order)
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
End Sub
?
Private Sub Command升序_Click()
If 排序 <> "" And IsNull(排序) = False Then
xf_order = 排序 & " ASC"
Else
xf_order = ""
End If
Adodc1.RecordSource = 生成查詢語(yǔ)句("學(xué)費(fèi)查詢", xf_filter, xf_order)
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
End Sub
Private Sub Command生成報(bào)表_Click()
DataReport學(xué)費(fèi)報(bào)表.DataMember = ""
With DataEnvironment1
.Commands(1).CommandType = adCmdText
'.Commands(3).CommandText = _
' "SHAPE {" & 生成查詢語(yǔ)句("學(xué)費(fèi)查詢", xf_filter, xf_order) & "}? AS Command學(xué)費(fèi)查詢 COMPUTE Command學(xué)費(fèi)查詢, SUM(Command學(xué)費(fèi)查詢.'學(xué)費(fèi)') AS 學(xué)費(fèi)合計(jì) BY '年份','月份'"
'.Commands(3).Execute ("SHAPE {" & 生成查詢語(yǔ)句("學(xué)費(fèi)查詢", xf_filter, xf_order) & "}? AS Command學(xué)費(fèi)查詢 COMPUTE Command學(xué)費(fèi)查詢, SUM(Command學(xué)費(fèi)查詢.'學(xué)費(fèi)') AS 學(xué)費(fèi)合計(jì) BY '年份','月份'")
.Commands(1).CommandText = _
?"SHAPE {" & 生成查詢語(yǔ)句("學(xué)費(fèi)查詢", xf_filter, xf_order) & "}? AS Command學(xué)費(fèi)查詢 COMPUTE Command學(xué)費(fèi)查詢, SUM(Command學(xué)費(fèi)查詢.'學(xué)費(fèi)') AS 學(xué)費(fèi)合計(jì), SUM(Command學(xué)費(fèi)查詢.'已收金額') AS 已收合計(jì), SUM(Command學(xué)費(fèi)查詢.'未交金額') AS 未交合計(jì) BY '學(xué)期'"
.Commands(1).Execute ("SHAPE {" & 生成查詢語(yǔ)句("學(xué)費(fèi)查詢", xf_filter, xf_order) & "}? AS Command學(xué)費(fèi)查詢 COMPUTE Command學(xué)費(fèi)查詢, SUM(Command學(xué)費(fèi)查詢.'學(xué)費(fèi)') AS 學(xué)費(fèi)合計(jì), SUM(Command學(xué)費(fèi)查詢.'已收金額') AS 已收合計(jì), SUM(Command學(xué)費(fèi)查詢.'未交金額') AS 未交合計(jì) BY '學(xué)期'")
If .rsCommand學(xué)費(fèi)查詢_分組.State = 1 Then
??? .rsCommand學(xué)費(fèi)查詢_分組.Close
End If
Set DataReport學(xué)費(fèi)報(bào)表.DataSource = DataEnvironment1
DataReport學(xué)費(fèi)報(bào)表.DataMember = "Command學(xué)費(fèi)查詢_分組"
End With
'打開報(bào)表
DataReport學(xué)費(fèi)報(bào)表.Show 1
End Sub
Private Sub Command添加_Click()
If 學(xué)費(fèi)添加權(quán)限 = False Then
MsgBox "無(wú)權(quán)限"
Exit Sub
End If
frm學(xué)費(fèi)添加.Show 1
End Sub
Private Sub Form_Load()
'篩選排序變量清空
xf_filter = ""
xf_order = "學(xué)費(fèi)ID DESC"
查詢內(nèi)容.Visible = True
'--隱藏日期控件
起始日期.Visible = False
截止日期.Visible = False
'--隱藏金額控件
最小.Visible = False
最大.Visible = False
'標(biāo)簽
Label查詢內(nèi)容.Visible = True
'--隱藏日期控件
Label起始日期.Visible = False
Label截止日期.Visible = False
'--隱藏金額控件
Label最小.Visible = False
Label最大.Visible = False
'ado控件設(shè)置
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db_xxsf.mdb;Jet OLEDB:DataBase password=abc123;Persist Security Info=False"
Adodc1.CommandType = adCmdUnknown
Adodc1.RecordSource = 生成查詢語(yǔ)句("學(xué)費(fèi)查詢", xf_filter, xf_order)
Adodc1.Refresh??? '刷新
'存儲(chǔ)數(shù)據(jù)表格控件與窗體寬高差值
dh = Me.Height - DataGrid1.Height
dw = Me.Width - DataGrid1.Width
End Sub
Function 生成查詢語(yǔ)句(ByVal searchtb As String, ByVal searchfilter As String, ByVal searchorder As String) As String
生成查詢語(yǔ)句 = ""
Dim sqltext As String
sqltext = "Select * From " & searchtb
If searchfilter <> "" Then
sqltext = sqltext & " where " & searchfilter
End If
If searchorder <> "" Then
sqltext = sqltext & " order by " & searchorder
End If
生成查詢語(yǔ)句 = sqltext
End Function
Private Sub Form_Resize()
'窗體大小變化表格控件尺寸改變
If Me.WindowState <> 1 Then
DataGrid1.Height = Me.Height - dh
DataGrid1.Width = Me.Width - dw
End If
End Sub
Private Sub 查詢字段_Click()
If 查詢字段 = "交費(fèi)日期" Then
起始日期.Visible = True
截止日期.Visible = True
最小.Visible = False
最大.Visible = False
查詢內(nèi)容.Visible = False
起始日期.Value = Date
截止日期.Value = Date
GoTo a1
Else
起始日期.Visible = False
截止日期.Visible = False
最小.Visible = False
最大.Visible = False
查詢內(nèi)容.Visible = True
End If
If 查詢字段 = "學(xué)費(fèi)" Or 查詢字段 = "已收金額" Or 查詢字段 = "未交金額" Then
起始日期.Visible = False
截止日期.Visible = False
最小.Visible = True
最大.Visible = True
查詢內(nèi)容.Visible = False
GoTo a1
Else
起始日期.Visible = False
截止日期.Visible = False
最小.Visible = False
最大.Visible = False
查詢內(nèi)容.Visible = True
End If
a1:
'標(biāo)簽
If 查詢字段 = "交費(fèi)日期" Then
Label起始日期.Visible = True
Label截止日期.Visible = True
Label最小.Visible = False
Label最大.Visible = False
Label查詢內(nèi)容.Visible = False
GoTo a2
Else
Label起始日期.Visible = False
Label截止日期.Visible = False
Label最小.Visible = False
Label最大.Visible = False
Label查詢內(nèi)容.Visible = True
End If
If 查詢字段 = "學(xué)費(fèi)" Or 查詢字段 = "已收金額" Or 查詢字段 = "未交金額" Then
Label起始日期.Visible = False
Label截止日期.Visible = False
Label最小.Visible = True
Label最大.Visible = True
Label查詢內(nèi)容.Visible = False
GoTo a2
Else
Label起始日期.Visible = False
Label截止日期.Visible = False
Label最小.Visible = False
Label最大.Visible = False
Label查詢內(nèi)容.Visible = True
End If
a2:
End Sub
學(xué)費(fèi)管理
Private Sub Command更新_Click()
On Error GoTo 更新失敗錯(cuò)誤
If 學(xué)費(fèi)更新權(quán)限 = False Then
MsgBox "無(wú)權(quán)限"
Exit Sub
End If
If MsgBox("是否更新該學(xué)費(fèi)記錄?", vbOKCancel) <> vbOK Then
Exit Sub
End If
If Text(0) = "" Or IsNull(Text(0)) = True Then
MsgBox "學(xué)期值不能為空！"
Exit Sub
Else
End If
If Text(1) = "" Or IsNull(Text(1)) = True Then
MsgBox "學(xué)號(hào)值不能為空！"
Exit Sub
Else
End If
If Text(2) = "" Or IsNull(Text(2)) = True Then
MsgBox "學(xué)費(fèi)值不能為空！"
Exit Sub
Else
End If
If Text(3) = "" Or IsNull(Text(3)) = True Then
MsgBox "已收金額不能為空！"
Exit Sub
Else
End If
'檢查學(xué)號(hào)是否已存在
??? If dcountlink("學(xué)號(hào)", "學(xué)生信息表", "學(xué)號(hào)='" & Text(1) & "'", 0) = 0 Then
??? MsgBox "該學(xué)號(hào)不存在，請(qǐng)修改后重試"
??? Exit Sub
??? End If
'連接數(shù)據(jù)庫(kù)并更新
Adodc1.Recordset.Update
MsgBox "更新完成！"
Exit Sub
更新失敗錯(cuò)誤:
MsgBox Err.Description
End Sub
?
Private Sub Command刪除_Click()
On Error GoTo 刪除失敗錯(cuò)誤
If 學(xué)費(fèi)刪除權(quán)限 = False Then
MsgBox "無(wú)權(quán)限"
Exit Sub
End If
If MsgBox("是否刪除該學(xué)費(fèi)記錄?", vbOKCancel) <> vbOK Then
Exit Sub
End If
Adodc1.Recordset.Delete
MsgBox "刪除完成"
Unload Me
Exit Sub
刪除失敗錯(cuò)誤:
MsgBox Err.Description
End Sub
?
Private Sub Form_Load()
'ado控件設(shè)置
Me.Adodc1.Refresh??? '刷新
Me.Adodc1.CommandType = adCmdUnknown
Me.Adodc1.RecordSource = "select * From 學(xué)費(fèi)表 where 學(xué)費(fèi)ID=" & xf_num
Me.Adodc1.Refresh??? '刷新
End Sub
?
?
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
frm學(xué)費(fèi)查詢.Adodc1.Refresh
frm學(xué)費(fèi)查詢.DataGrid1.Refresh
End Sub
?
Private Sub DTPicker1_LostFocus()
DTPicker1.Format = dtpCustom??? '日期格式設(shè)置
Text(5).Text = DTPicker1.Value? '返回選擇的日期值至文本框
DTPicker1.Visible = False?????? '日期控件隱藏
End Sub
?
?
Private Sub Text_DblClick(Index As Integer)
If Index = 0 Then
?? xf_formname = "frm學(xué)費(fèi)管理"
?? frm學(xué)期選擇.Show 1
End If
If Index = 1 Then
?? student_formname = "frm學(xué)費(fèi)管理"
?? frm學(xué)生選擇.Show 1
End If
If Index = 5 Then?????? '雙擊輸入日期的文本框
?? If Text(5) <> "" Then
?? DTPicker1.Value = Text(5)
?? Else
?? Text(5) = Date
?? DTPicker1.Value = Date
?? End If
?? DTPicker1.Visible = True???? '顯示日期選擇控件
End If
End Sub
?
Private Sub Text_LostFocus(Index As Integer)
If Index = 5 Then?????? '輸入日期的文本框失去焦點(diǎn)
?? If Text(5).Text <> "" And IsDate(Text(5)) = False Then
????? MsgBox "輸入的數(shù)據(jù)不是日期類型，請(qǐng)重新輸入"
????? Text(5).Text = ""
????? DTPicker1.Value = False
????? Exit Sub
?? End If
End If
If Index = 2 Then?????? '輸入貨幣格式的文本框失去焦點(diǎn)
?? If Text(2).Text <> "" And IsNumeric(Text(2)) = False Then
????? MsgBox "輸入的數(shù)據(jù)不是貨幣類型，請(qǐng)重新輸入"
????? Text(2).Text = ""
????? Exit Sub
?? End If
End If
If Index = 3 Then?????? '輸入貨幣格式的文本框失去焦點(diǎn)
?? If Text(3).Text <> "" And IsNumeric(Text(3)) = False Then
????? MsgBox "輸入的數(shù)據(jù)不是貨幣類型，請(qǐng)重新輸入"
????? Text(3).Text = ""
????? Exit Sub
?? End If
End If
End Sub
