功能模块图

业务流程图

数据流图

ER图

关系模型

考试费（考试名称，学号，考试费，已收金额，未交金额，交费日期，备注）

教材费（教材名称，学号，教材费，已收金额，未交金额，交费日期，备注）

学费（学期，学号，学费，已收金额，未交金额，交费日期，备注）

学生信息表（学号，姓名，性别，班级，学院，联系方式）

其他费表（费用名称，学号，其他费，已收金额，未交金额，交费日期，备注）

住宿费表（宿舍名称，住宿时间，学号，住宿费，已收金额，未交金额，交费日期，备注）

程序流程图

Access数据库

表

考试费表

考试表

班级表

教材费表

教材表

宿舍表

学费表

学生信息表

学期表

其他费表      

住宿费表

账户表

表关系

查询

教材费查询

考试费查询

;

其他费查询

学费查询

学生教材费查询

学生考试费查询

学生其他费查询

学生信息查询

学生学费查询

学生住宿费查询

住宿费查询

示例模块（学费管理）

学费添加

Dim dh As Long  '存储高度差

Dim dw As Long  '存储宽度差

Private Sub Text_DblClick(Index As Integer)

If Index = 0 Then

   xf_formname = "frm学费添加"

   frm学期选择.Show 1

End If

If Index = 1 Then

   student_formname = "frm学费添加"

   frm学生选择.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 错误提示

If 学费添加权限 = False Then

MsgBox "无权限"

Exit Sub

End If

'判断必须输入数据的控件不能为空

If Text(0) = "" Or IsNull(Text(0)) = True Then

MsgBox "学期值不能为空！"

Exit Sub

Else

End If

If Text(1) = "" Or IsNull(Text(1)) = True Then

MsgBox "学号值不能为空！"

Exit Sub

Else

End If

If Text(2) = "" Or IsNull(Text(2)) = True Then

MsgBox "学费值不能为空！"

Exit Sub

Else

End If

If Text(3) = "" Or IsNull(Text(3)) = True Then

MsgBox "已收金额不能为空！"

Exit Sub

Else

End If

'检查学号是否已存在

    If dcountlink("学号", "学生信息表", "学号='" & Text(1) & "'", 0) = 0 Then

    MsgBox "该学号不存在，请修改后重试"

    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 "学费表", add_conn, adOpenKeyset, adLockOptimistic

       add_rs.AddNew

'       On Error Resume Next

            add_rs!学期.Value = Text(0).Text

            add_rs!学号.Value = Text(1).Text

            add_rs!学费.Value = Text(2).Text

            add_rs!已收金额.Value = Text(3).Text

            add_rs!备注.Value = Text(4).Text

            add_rs!交费日期.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

错误提示:

MsgBox Err.Description

End Sub

Private Sub Form_Load()

'ado控件设置

Me.Adodc1.CommandType = adCmdUnknown

Me.Adodc1.RecordSource = "select * From 学费表 Order By 学费ID DESC"

Me.Adodc1.Refresh    '刷新

'存储数据表格控件与窗体宽高差值

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学费查询.Adodc1.Refresh

frm学费查询.DataGrid1.Refresh

End Sub

Private Sub DTPicker1_LostFocus()

DTPicker1.Format = dtpCustom    '日期格式设置

Text(5).Text = DTPicker1.Value  '返回选择的日期值至文本框

DTPicker1.Visible = False       '日期控件隐藏

End Sub

Private Sub Text_LostFocus(Index As Integer)

If Index = 5 Then       '输入日期的文本框失去焦点

   If Text(5).Text <> "" And IsDate(Text(5)) = False Then

      MsgBox "输入的数据不是日期类型，请重新输入"

      Text(5).Text = ""

      DTPicker1.Value = False

      Exit Sub

   End If

End If

If Index = 2 Then       '输入货币格式的文本框失去焦点

   If Text(2).Text <> "" And IsNumeric(Text(2)) = False Then

      MsgBox "输入的数据不是货币类型，请重新输入"

      Text(2).Text = ""

      Exit Sub

   End If

End If

If Index = 3 Then       '输入货币格式的文本框失去焦点

   If Text(3).Text <> "" And IsNumeric(Text(3)) = False Then

      MsgBox "输入的数据不是货币类型，请重新输入"

      Text(3).Text = ""

      Exit Sub

   End If

End If

End Sub

学费查询

Dim dh As Long  '存储高度差

Dim dw As Long  '存储宽度差

Private Sub Command查询1_Click()    '单条件查询

On Error GoTo 结束查询

Dim search_field As String

If 查询字段 = "交费日期" 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 = 生成查询语句("学费查询", xf_filter, xf_order)

    Adodc1.Refresh

    DataGrid1.Refresh

    DataGrid1.SetFocus

    Exit Sub

End If

If 查询字段 = "学费" 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 = 生成查询语句("学费查询", xf_filter, xf_order)

    Adodc1.Refresh

    DataGrid1.Refresh

    DataGrid1.SetFocus

    Exit Sub

End If

If 查询内容 <> "" And IsNull(查询内容) = False And 查询字段 <> "" And IsNull(查询字段) = False Then

    search_field = 查询字段

    xf_filter = search_field & " like '%" & 查询内容 & "%'"

Else

    xf_filter = ""

End If

    Adodc1.RecordSource = 生成查询语句("学费查询", xf_filter, xf_order)

    Adodc1.Refresh

    DataGrid1.Refresh

    DataGrid1.SetFocus

    Exit Sub

结束查询:

    MsgBox Err.Description

End Sub

Private Sub Command管理_Click()

On Error GoTo A1

xf_num = DataGrid1.Columns(0).Text

frm学费管理.Show 1

A1:

End Sub

Private Sub Command降序_Click()

If 排序 <> "" And IsNull(排序) = False Then

xf_order = 排序 & " DESC"

Else

xf_order = ""

End If

Adodc1.RecordSource = 生成查询语句("学费查询", xf_filter, xf_order)

Adodc1.Refresh

DataGrid1.Refresh

DataGrid1.SetFocus

End Sub

Private Sub Command全部_Click()

xf_filter = ""

Adodc1.RecordSource = 生成查询语句("学费查询", 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 = 生成查询语句("学费查询", xf_filter, xf_order)

Adodc1.Refresh

DataGrid1.Refresh

DataGrid1.SetFocus

End Sub

Private Sub Command生成报表_Click()

DataReport学费报表.DataMember = ""

With DataEnvironment1

.Commands(1).CommandType = adCmdText

'.Commands(3).CommandText = _

' "SHAPE {" & 生成查询语句("学费查询", xf_filter, xf_order) & "}  AS Command学费查询 COMPUTE Command学费查询, SUM(Command学费查询.'学费') AS 学费合计 BY '年份','月份'"

'.Commands(3).Execute ("SHAPE {" & 生成查询语句("学费查询", xf_filter, xf_order) & "}  AS Command学费查询 COMPUTE Command学费查询, SUM(Command学费查询.'学费') AS 学费合计 BY '年份','月份'")

.Commands(1).CommandText = _

 "SHAPE {" & 生成查询语句("学费查询", xf_filter, xf_order) & "}  AS Command学费查询 COMPUTE Command学费查询, SUM(Command学费查询.'学费') AS 学费合计, SUM(Command学费查询.'已收金额') AS 已收合计, SUM(Command学费查询.'未交金额') AS 未交合计 BY '学期'"

.Commands(1).Execute ("SHAPE {" & 生成查询语句("学费查询", xf_filter, xf_order) & "}  AS Command学费查询 COMPUTE Command学费查询, SUM(Command学费查询.'学费') AS 学费合计, SUM(Command学费查询.'已收金额') AS 已收合计, SUM(Command学费查询.'未交金额') AS 未交合计 BY '学期'")

If .rsCommand学费查询_分组.State = 1 Then

    .rsCommand学费查询_分组.Close

End If

Set DataReport学费报表.DataSource = DataEnvironment1

DataReport学费报表.DataMember = "Command学费查询_分组"

End With

'打开报表

DataReport学费报表.Show 1

End Sub

Private Sub Command添加_Click()

If 学费添加权限 = False Then

MsgBox "无权限"

Exit Sub

End If

frm学费添加.Show 1

End Sub

Private Sub Form_Load()

'筛选排序变量清空

xf_filter = ""

xf_order = "学费ID DESC"

查询内容.Visible = True

'--隐藏日期控件

起始日期.Visible = False

截止日期.Visible = False

'--隐藏金额控件

最小.Visible = False

最大.Visible = False

'标签

Label查询内容.Visible = True

'--隐藏日期控件

Label起始日期.Visible = False

Label截止日期.Visible = False

'--隐藏金额控件

Label最小.Visible = False

Label最大.Visible = False

'ado控件设置

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 = 生成查询语句("学费查询", xf_filter, xf_order)

Adodc1.Refresh    '刷新

'存储数据表格控件与窗体宽高差值

dh = Me.Height - DataGrid1.Height

dw = Me.Width - DataGrid1.Width

End Sub

Function 生成查询语句(ByVal searchtb As String, ByVal searchfilter As String, ByVal searchorder As String) As String

生成查询语句 = ""

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

生成查询语句 = 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 查询字段 = "交费日期" Then

起始日期.Visible = True

截止日期.Visible = True

最小.Visible = False

最大.Visible = False

查询内容.Visible = False

起始日期.Value = Date

截止日期.Value = Date

GoTo a1

Else

起始日期.Visible = False

截止日期.Visible = False

最小.Visible = False

最大.Visible = False

查询内容.Visible = True

End If

If 查询字段 = "学费" Or 查询字段 = "已收金额" Or 查询字段 = "未交金额" Then

起始日期.Visible = False

截止日期.Visible = False

最小.Visible = True

最大.Visible = True

查询内容.Visible = False

GoTo a1

Else

起始日期.Visible = False

截止日期.Visible = False

最小.Visible = False

最大.Visible = False

查询内容.Visible = True

End If

a1:

'标签

If 查询字段 = "交费日期" Then

Label起始日期.Visible = True

Label截止日期.Visible = True

Label最小.Visible = False

Label最大.Visible = False

Label查询内容.Visible = False

GoTo a2

Else

Label起始日期.Visible = False

Label截止日期.Visible = False

Label最小.Visible = False

Label最大.Visible = False

Label查询内容.Visible = True

End If

If 查询字段 = "学费" Or 查询字段 = "已收金额" Or 查询字段 = "未交金额" Then

Label起始日期.Visible = False

Label截止日期.Visible = False

Label最小.Visible = True

Label最大.Visible = True

Label查询内容.Visible = False

GoTo a2

Else

Label起始日期.Visible = False

Label截止日期.Visible = False

Label最小.Visible = False

Label最大.Visible = False

Label查询内容.Visible = True

End If

a2:

End Sub

学费管理

Private Sub Command更新_Click()

On Error GoTo 更新失败错误

If 学费更新权限 = False Then

MsgBox "无权限"

Exit Sub

End If

If MsgBox("是否更新该学费记录?", vbOKCancel) <> vbOK Then

Exit Sub

End If

If Text(0) = "" Or IsNull(Text(0)) = True Then

MsgBox "学期值不能为空！"

Exit Sub

Else

End If

If Text(1) = "" Or IsNull(Text(1)) = True Then

MsgBox "学号值不能为空！"

Exit Sub

Else

End If

If Text(2) = "" Or IsNull(Text(2)) = True Then

MsgBox "学费值不能为空！"

Exit Sub

Else

End If

If Text(3) = "" Or IsNull(Text(3)) = True Then

MsgBox "已收金额不能为空！"

Exit Sub

Else

End If

'检查学号是否已存在

    If dcountlink("学号", "学生信息表", "学号='" & Text(1) & "'", 0) = 0 Then

    MsgBox "该学号不存在，请修改后重试"

    Exit Sub

    End If

'连接数据库并更新

Adodc1.Recordset.Update

MsgBox "更新完成！"

Exit Sub

更新失败错误:

MsgBox Err.Description

End Sub

Private Sub Command删除_Click()

On Error GoTo 删除失败错误

If 学费删除权限 = False Then

MsgBox "无权限"

Exit Sub

End If

If MsgBox("是否删除该学费记录?", vbOKCancel) <> vbOK Then

Exit Sub

End If

Adodc1.Recordset.Delete

MsgBox "删除完成"

Unload Me

Exit Sub

删除失败错误:

MsgBox Err.Description

End Sub

Private Sub Form_Load()

'ado控件设置

Me.Adodc1.Refresh    '刷新

Me.Adodc1.CommandType = adCmdUnknown

Me.Adodc1.RecordSource = "select * From 学费表 where 学费ID=" & xf_num

Me.Adodc1.Refresh    '刷新

End Sub

Private Sub Form_Unload(Cancel As Integer)

On Error Resume Next

frm学费查询.Adodc1.Refresh

frm学费查询.DataGrid1.Refresh

End Sub

Private Sub DTPicker1_LostFocus()

DTPicker1.Format = dtpCustom    '日期格式设置

Text(5).Text = DTPicker1.Value  '返回选择的日期值至文本框

DTPicker1.Visible = False       '日期控件隐藏

End Sub

Private Sub Text_DblClick(Index As Integer)

If Index = 0 Then

   xf_formname = "frm学费管理"

   frm学期选择.Show 1

End If

If Index = 1 Then

   student_formname = "frm学费管理"

   frm学生选择.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       '输入日期的文本框失去焦点

   If Text(5).Text <> "" And IsDate(Text(5)) = False Then

      MsgBox "输入的数据不是日期类型，请重新输入"

      Text(5).Text = ""

      DTPicker1.Value = False

      Exit Sub

   End If

End If

If Index = 2 Then       '输入货币格式的文本框失去焦点

   If Text(2).Text <> "" And IsNumeric(Text(2)) = False Then

      MsgBox "输入的数据不是货币类型，请重新输入"

      Text(2).Text = ""

      Exit Sub

   End If

End If

If Index = 3 Then       '输入货币格式的文本框失去焦点

   If Text(3).Text <> "" And IsNumeric(Text(3)) = False Then

      MsgBox "输入的数据不是货币类型，请重新输入"

      Text(3).Text = ""

      Exit Sub

   End If

End If

End Sub

以上内容仅供参考，如果需要系统源文件和设计资料文档可在主页联系