山东交通学院
课程设计报告
题目： 家庭财务管理系统
所在学院： 信息科学与电气工程学院
班 级： 计算124
学 号： 120811413
姓 名： 张滨
指导教师： 庞希愚
20##年3月28日
课 程 设 计 任 务 书
题 目 家庭财务系统
系 (部) 信息科学与电气工程学院
专 业 计算机科学与技术
班 级 计算124
学生姓名 张滨
学 号 120811413
指导教师(签字)
系主任(签字)
年 月 日
成 绩 评 定 表
目录
概述
1.1系统开发的背景与意义
1.1.1系统开发背景
1.1.2系统开发意义
二、需求分析
2.1系统可行性分析
2.1.1功能划分
2.1.2 功能描述
2.2系统功能要求
2.3系统功能模块
2.4系统架构
三、概念设计
3.1E-R图
四、系统实现
五、小结
一、概述
1.1系统开发的背景与意义
1.1.1系统开发背景
现在不论哪个家庭，都要会进行财务管理，家庭财务管理系统利用计算机管理财务工作, 改善了收入与支出的管理效率,所以手动记账已经很难再满足家庭的财务日常消费，随着数据库技术的发展和企业信息化建设的进行，使用计算机管理家庭财务成为一种主流趋势，
本文系统的阐述了家庭财务管理设计开发的全过程。包括系统需求调查分析，概念结构设计，逻辑结构设计等部分。
1.1.2系统开发意义
1提高家庭对财务管理的认识，确保家庭收入与支出呈一定比例，杜绝过度消费的年轻夫妇每月月底信用卡的透支。
2对家庭的财务管理透明化，减少家庭的财务矛盾，确保家庭财务的增长收益。
二、需求分析
本系统要达到的目标有以下几点：
◆ 验证用户和密码的正确性再登入，以及修改密码和退出系统；
◆ 保存每次输入的收支记录，并提供查询方式；
◆ 能够提供一定的安全机制。
2.1系统可行性分析
系统可行性分析
可行性研究的目的是用最小的代价在尽可能短的时间内确定问题是否能够解决。从现在应用的技术方面、管理者和用户的操作方式方面研究智能家庭理财系统的可行性和必要性。智能家庭理财系统的实施，将很大程度上提高现代家庭的理财效率，使得现代家庭能够更加方便的对自己的财务进行个性化的管理。
技术可行性
技术可行性研究的任务，是从总体上鉴别和选择技术系统，是研究现有的技术条件能否顺利完成开发工作，硬、软件配置能否满足开发的需求等等。本系统的开发使用Eclipse 作为系统开发的开发环境，它作为一种现代化的编程语言，提供完善的指令控制语句、类与对象的支持及丰富的数据类型，给开发高性能系统提供了保障，为开发满足客户要求的系统保证了代码的模块化要求，而代码模块化的提高，非常有利于以后对新系统的扩展与修改。
综上所述，本系统为一个小型的家庭理财系统，所耗费的资源非常的小，现行的电脑无论是硬件还是软件都能够满足条件，因此，本系统在技术上是可行的。
经济可行性
进行软件开发项目成本的估算以及了解取得效益的评估，确定要开发的项目是否值得投资开发，这些即为经济可行性。
如今，随着计算机的大量普及，各种软件的开发成本越来越低，价格也越来越 底。本系统也是这样，开发成本较低，只是需要一台配置一般的计算机，该系统运行时占计算机的资源也不多，但并不会因为开发成本低而造成系统功能性能的下降。相反，随着计算机技术的发展,各种实用软件的性能日渐提高。家庭理财管理系统廉价的开发成本，却能够为居民带来相当大的实惠和方便。主要表现在：
(1)本系统是一个拥有多种实用功能的家庭理财管理信息系统，它集成了家庭成员管理、收入管理、支出管理、密码管理等多种功能，具有较强的实用性和方便性。
(2)本系统的运行可以大大提高居民管理财务的效率，减少不必要的人力和物力。
(3)本系统还具有查询和统计功能，能够查询到用户在一段特定时间内收入和支出的情况，特别是支出情况，有时往往会让用户在月底吓一跳，大大超出预算，还弄不清钱都花到哪里了。有了家庭理财系统，不仅使用户对口袋里钱的去向一目了然，而且可以帮助用户渐渐感悟到一些心得，摸清哪些花费是必要的，哪些“意外开支”是可以避免的，哪笔开支是可继续评估其必要性的。
(4)本系统的运行可以大大的提高家庭的工作效率，并可以使敏感文档更加安全。
由此可以得出，本系统在经济上是具有可行性的。
2.2系统功能要求
◆ 对理财项目可以进行编辑。理财项目包括日常收入来源和支出类型，相关
信息存在“收入来源表”、“支出类型表”、“活期账户信息表”均可以实现添加、删除、修改功能；
◆日常财务管理，包括日常收入和日常支出，即记下日常的收入和日常的支出。相关信息存入“收入信息表”和“支出信息表”中，均可以实现添加、删除、
修改功能。
◆ 理财分析，实现分类查询，即按类别查询收支明细，而且可以看到收支的财务分析报告，并可打印；
◆数据维护：包括数据库的备份、数据库的导入/出，方便用户保存和早期查询
2.3系统功能模块
根据上述系统总体架构思想的分析，可将系统分为以下六大部分：
◆系统管理模块
负责对用户和数据库进行管理
◆基础数据管理模块
负责对收支项目和家庭成员进行管理
◆日常收支管理模块
负责对日常收入和日常支出进行管理
最后得到如图示系统功能模块图
2.4系统架构
三、概念设计
3.1E-R图
四、系统实现
一、登陆界面
二、主功能界面
三、财务支出管理
四、财务收入管理界面
五、账户管理
五、经验与总结
（1）对技术方法的评价
软件项目开发过程需要一种方法能够持续对其进行监控和改善其中存在的问题。以往的件开发过程使用软件缺陷管理系统对发现的缺进行跟踪和修复,但是能够合理利用缺陷数据进分析统计的却不多,许多统计到的缺陷信息并没得到很好的利用。
（2）出错原因的分析
数据库链接是没有正确找到数据源而出错；没调试好软件，稍微耽搁了软件的调试进程；类与类之间的区别及联系没有更好地连接。
(3)经验
一定要向有经验的同学请教；
多去图书馆查阅相关资料；
做任何事情一定要静下心来，不能急于求成；
软件调试时一定要克服自己，让别的同学协助检查错误；
书写文档最好按照规范来实现，可以少走弯路。
小结：
本次课程设计基本达到预定的目标，通过本次课程设计多学习了java语言，同时加深了对数据库知识的理解与更好的运用；增强了实际动手能力，把理论转化为实际的建模能力。
本次考系统设计的并不是很完善很完美，出现了一些瑕疵，针对诸多设计过程中出现的一些小问题，通过仔细查找资料，将这些小问题慢慢解决，将系统逐步完善。对于一些尚未解决的问题，我们将会一如既往的，本着踏实实干，发愤图强的精神，
努力提高我们自身的专业素质和相关专业知识，为祖国的美好未来贡献自己的一些微薄力量。
第二篇：家庭财务管理系统课程设计的原代码
1、frm_borrowgo.frm
Dim Mydb As New ADODB.Recordset
Dim Mydb1 As New ADODB.Recordset
Dim Str_text As String
Dim strflag As String
Private Sub cmd_add_Click()
txt_man.Locked = False
txt_way.Locked = False
txt_money.Locked = False
Combo1.Locked = False
Check1.Enabled = True
DTPicker1.Enabled = True
txt_man.Text = ""
txt_way.Text = ""
txt_money.Text = ""
Combo1.Text = ""
strflag = "添加"
Cmdsave.Enabled = True
End Sub
Private Sub cmd_close_Click()
Unload Me
End Sub
Private Sub cmd_del_Click()
Dim A As Boolean
A = MsgBox("是否真的要删除这条记录？", vbOKCancel + 32 + 256, "删除") If A = True Then
ExeCutesql "delete from 借出 where 得款人='" & txt_man.Text & "'", Str_text MsgBox "记录已删除！", , "删除"
If Mydb.RecordCount > 0 Then
Mydb.MoveNext
If Mydb.EOF Then Mydb.MoveLast
Call Db
Call Bangding
Label7.Caption = Mydb.RecordCount
End If
End If
End Sub
Private Sub cmd_edit_Click()
On Error Resume Next
Dim A As Boolean
txt_man.Locked = False
txt_way.Locked = False
txt_money.Locked = False
Combo1.Locked = False
Check1.Enabled = True
DTPicker1.Enabled = True
strflag = "修改"
Cmdsave.Enabled = True
End Sub
Private Sub Cmdsave_Click()
On Error Resume Next
Dim A As Boolean
If strflag = "添加" Then
A = MsgBox("是否添加前记录？", vbYesNo + 32, "添加记录")
If A = True Then
ExeCutesql "insert into 借出 values('" & txt_man.Text & "','" & txt_money.Text & "','" & Combo1.Text & "','" & DTPicker1.Value & "','" & txt_way.Text & "','" & Check1.Value & "')", Str_text
MsgBox "数据已经保存！", vbOKOnly + 64, "成功"
Call Db
Label7.Caption = Mydb.RecordCount
End If
ElseIf strflag = "修改" Then
A = MsgBox("是否修改前记录？", vbYesNo + 32, "添加记录")
If A = True Then
Mydb.Update
'Mydb.Requery
Call Db
MsgBox "数据修改成功！", vbOKOnly + 64, "成功"
End If
End If
Cmdsave.Enabled = False
txt_man.Locked = True
txt_way.Locked = True
txt_money.Locked = True
Combo1.Locked = True
Check1.Enabled = False
DTPicker1.Enabled = False
End Sub
Private Sub Combo1_Change()
Dim A As Integer
Set Mydb1 = ExeCutesql("select 姓名 from 成员", Str_text) ' Set Combo1.DataSource = Mydb1
A = Mydb1.RecordCount
For I = 1 To A
Combo1.AddItem Mydb1.Fields(0)
Mydb1.MoveNext
If Mydb1.EOF Then Exit For
Next I
End Sub
Private Sub Command1_Click()
On Error Resume Next
'Call Db
Mydb.MoveFirst
Call Bangding
End Sub
Private Sub Command2_Click()
On Error Resume Next
'Call Db
'If Not Mydb.BOF Then Mydb.MovePrevious
Mydb.MovePrevious
If Mydb.BOF Then
MsgBox "这已经是第一条记录了！", vbOKOnly + 32, "注意" Mydb.MoveFirst
End If
Call Bangding
End Sub
Private Sub Command3_Click()
On Error Resume Next
'Call Db
'Mydb.MovePrevious
'If Mydb.BOF Then
' MsgBox "这已经是第一条记录了！", vbOKOnly + 32, "注意" ' Mydb.MoveFirst
'End If
Mydb.MoveNext
If Mydb.EOF Then
MsgBox "这已经是最后一条记录了！", vbOKOnly + 32, "注意" Mydb.MoveLast
End If
Call Bangding
End Sub
Private Sub Command4_Click()
On Error Resume Next
'Call Db
Mydb.MoveLast
Call Bangding
End Sub
Private Sub Form_Load()
On Error Resume Next
'Set Mydb = ExeCutesql("select * from 借出", Str_text) Call Db
'Call Bangding
Check1.Value = 0
Label7.Caption = Mydb.RecordCount
DTPicker1.Value = Date
Cmdsave.Enabled = False
txt_man.Locked = True
txt_way.Locked = True
txt_money.Locked = True
Combo1.Locked = True
Check1.Enabled = False
DTPicker1.Enabled = False
End Sub
Private Function Db()
On Error Resume Next
Set Mydb = ExeCutesql("select * from 借出", Str_text) End Function
Private Function Bangding()
On Error Resume Next
Set txt_man.DataSource = Mydb
Set txt_money.DataSource = Mydb
Set DTPicker1.DataSource = Mydb
Set txt_way.DataSource = Mydb
Set Check1.DataSource = Mydb
txt_man.DataField = "得款人"
txt_money.DataField = "金额"
DTPicker1.Value = "日期"
txt_way.DataField = "借款原因"
Check1.DataField = "已还"
Set Combo1.DataSource = Mydb
Combo1.DataField = "出借人"
End Function
2、frm_borromin.frm
Dim Mydb As New ADODB.Recordset
Dim Mydb1 As New ADODB.Recordset
Dim Str_text As String
Dim strflag As String
Private Sub cmd_close_Click()
Unload Me
End Sub
Private Sub cmd_add_Click()
txt_man.Locked = False
txt_way.Locked = False
txt_money.Locked = False
Combo1.Locked = False
Check1.Enabled = True
DTPicker1.Enabled = True
txt_man.Text = ""
txt_way.Text = ""
txt_money.Text = ""
Combo1.Text = ""
strflag = "添加"
Cmdsave.Enabled = True
End Sub
Private Sub cmd_del_Click()
Dim A As Boolean
A = MsgBox("是否真的要删除这条记录？", vbOKCancel + 32 + 256, "删除") If A = True Then
ExeCutesql "delete from 借入 where 得款人='" & txt_man.Text & "'", Str_text MsgBox "记录已删除！", , "删除"
If Mydb.RecordCount > 0 Then
Mydb.MoveNext
If Mydb.EOF Then Mydb.MoveLast
Call Db
Call Bangding
Label7.Caption = Mydb.RecordCount
End If
End If
End Sub
Private Sub cmd_edit_Click()
On Error Resume Next
Dim A As Boolean
txt_man.Locked = False
txt_way.Locked = False
txt_money.Locked = False
Combo1.Locked = False
Check1.Enabled = True
DTPicker1.Enabled = True
strflag = "修改"
Cmdsave.Enabled = True
End Sub
Private Sub Cmdsave_Click()
On Error Resume Next
Dim A As Boolean
If strflag = "添加" Then
A = MsgBox("是否添加前记录？", vbYesNo + 32, "添加记录")
If A = True Then
ExeCutesql "insert into 借入 values('" & txt_man.Text & "','" & txt_money.Text & "','" & Combo1.Text & "','" & Format(DTPicker1.Value, "yyyy-mm-dd") & "','" & txt_way.Text & "','" & Check1.Value & "')", Str_text
MsgBox "数据已经保存！", vbOKOnly + 64, "成功"
Call Db
Label7.Caption = Mydb.RecordCount
End If
ElseIf strflag = "修改" Then
A = MsgBox("是否修改前记录？", vbYesNo + 32, "添加记录")
If A = True Then
Mydb.Update
'Mydb.Requery
Call Db
MsgBox "数据修改成功！", vbOKOnly + 64, "成功"
End If
End If
txt_man.Locked = True
txt_way.Locked = True
txt_money.Locked = True
Combo1.Locked = True
Check1.Enabled = False
DTPicker1.Enabled = False
Cmdsave.Enabled = False
End Sub
Private Sub Combo1_Change()
Set Mydb1 = ExeCutesql("select 姓名 from 成员", Str_text) 'Set Combo1.DataSource = Mydb1
For I = 1 To Mydb1.RecordCount
Combo1.AddItem (Mydb1.Fields(0))
Mydb1.MoveNext
If Mydb1.EOF Then Exit For
Next I
End Sub
Private Sub Command1_Click()
On Error Resume Next
' Call Db
Mydb.MoveFirst
Call Bangding
End Sub
Private Sub Command3_Click()
On Error Resume Next
'Call Db
Mydb.MoveNext
If Mydb.EOF Then
MsgBox "这已经是最后一条记录了！", vbOKOnly + 32, "注意" Mydb.MoveLast
End If
Call Bangding
End Sub
Private Sub Command2_Click()
On Error Resume Next
Mydb.MovePrevious
If Mydb.BOF Then
MsgBox "这已经是第一条记录了！", vbOKOnly + 32, "注意" Mydb.MoveFirst
End If
Call Bangding
End Sub
Private Sub Command4_Click()
On Error Resume Next
'Call Db
Mydb.MoveLast
Call Bangding
End Sub
Private Sub Form_Load()
On Error Resume Next
Call Db
Call Bangding
Cmdsave.Enabled = False
Check1.Value = 0
Label7.Caption = Mydb.RecordCount
DTPicker1.Value = Date
txt_man.Locked = True
txt_way.Locked = True
txt_money.Locked = True
Combo1.Locked = True
Check1.Enabled = False
DTPicker1.Enabled = False
End Sub
Private Function Db()
Set Mydb = ExeCutesql("select * from 借入", Str_text) End Function
Private Function Bangding()
On Error Resume Next
Set txt_man.DataSource = Mydb
Set txt_money.DataSource = Mydb
Set DTPicker1.DataSource = Mydb
Set txt_way.DataSource = Mydb
Set Check1.DataSource = Mydb
txt_man.DataField = "得款人"
txt_money.DataField = "金额"
DTPicker1.DataField = "日期"
txt_way.DataField = "出借原因"
Check1.DataField = "已还"
Set Combo1.DataSource = Mydb
Combo1.DataField = "出借人"
End Function
3、frm_choose.frm
Private Sub cmd_choose_Click()
On Error Resume Next
CommonDialog1.Filter = "database(*.mdb)|*.mdb" CommonDialog1.ShowOpen
Str_path = CommonDialog1.FileName
Text1.Text = CommonDialog1.FileName
SaveSetting "小财迷", "personal", "路径", Str_path
Text2.Text = CommonDialog1.FileName
If Text2.Text <> "" Then
frm_login.Show
Unload Me
Else
Show
End If
End Sub
Private Sub cmd_ok_Click()
On Error Resume Next
Str_path = Text1.Text
SaveSetting "小财迷", "personal", "路径", Str_path
frm_login.Show
Unload Me
End Sub
4、frm_date.frm
Dim Mydb As New ADODB.Recordset
Dim Riqi, Riqi1, Year1, Month As String
Private Sub Command1_Click()
'Dim Riqi, Riqi1, Year, Month As String
If Combo1.Text = "" Then
MsgBox "请选择年份！", vbOKOnly + 32, "注意！"
Else
If Combo2.Text = "" Then
MsgBox "请选择月份！", vbOKOnly + 32, "注意！"
Else
AA = True
Year1 = Combo1.Text
Month = Combo2.Text
Riqi = Year1 & "-" & Month
Riqi1 = Year1 & "-" & Month + 1
'MsgBox Riqi
'Set Mydb = ExeCutesql("select * from 收入 where 日期 between '" & Riqi & "' and '" & Riqi1 & "' ", "")
Cdate1 = Format(Riqi, "yyyy-mm")
Cdate2 = Format(Riqi1, "yyyy-mm")
Unload Me
End If
End If
End Sub
Private Sub Form_Load()
Dim A As Integer
A = 2000
For I = 2000 To Int(Year(Now))
Combo1.AddItem A
A = A + 1
Next I
End Sub
5、frm_expend.frm
Dim Mydb As New ADODB.Recordset
Dim Mydb1 As New ADODB.Recordset
Dim Mydb2 As New ADODB.Recordset
Dim Count1 As New ADODB.Recordset
Dim Str_text As String
Private Sub cmd_add_Click()
On Error Resume Next
Dim A, B
B = 1
Set Count1 = ExeCutesql("select * from 支出", Str_text)
Count1.MoveLast
B = Count1.Fields(7) + 1
A = MsgBox("是否添加前记录？", vbYesNo + 32, "添加记录")
If A = vbYes Then
If txt_intake.Text = "" Then
MsgBox "请填写去向！", vbOKOnly + 32, "注意！"
Else
ExeCutesql "insert into 支出 values('" & Format(DTPicker1.Value, "yyyy-mm-dd") & "','" _
& Combo1.Text & "','" & txt_money.Text & "','" & Combo2.Text & "','" & txt_intake.Text _
& "','" & Combo3.Text & "','" & txt_mome.Text & "','" & B & "')", Str_text MsgBox "数据已经保存！", vbOKOnly + 64, "成功"
Call Xiangmu
Call Db
End If
End If
End Sub
Private Sub cmd_close_Click()
Unload Me
End Sub
Private Sub cmd_del_Click()
On Error Resume Next
Dim A
A = MsgBox("是否删除当前记录？", vbYesNo + 32 + 256, "添加记录") If A = vbYes Then
ExeCutesql "DELETE from 支出 where key=" & txt_note.Text & "", Str_text Call Db
Set Mydb = ExeCutesql("select * from 支出 ", Str_text)
Set MSHFlexGrid1.DataSource = Mydb
End If
End Sub
Private Sub cmd_edit_Click()
On Error Resume Next
Dim A
A = MsgBox("是否修改前记录？", vbYesNo + 32, "添加记录")
If A = vbYes Then
ExeCutesql "Update 支出 Set 日期 = '" & Format(DTPicker1.Value, "yyyy-mm-dd") & "',方式='" & Combo1.Text & "',金额=" & txt_money.Text & ", 去向='" & txt_intake.Text & "',人员='" & Combo3.Text & "',备注='" & txt_mome.Text & "' Where key = " & txt_note.Text & " ", Str_text
'Mydb.Requery
Call Db
MsgBox "数据修改成功！", vbOKOnly + 64, "成功"
End If
End Sub
Private Sub Combo2_Change()
Call Db1
End Sub
Private Sub Combo3_Change()
Call Db2
End Sub
Private Sub Form_Load()
Call Db
Call Db1
Call Db2
DTPicker1.Value = Date
' Combo3.Locked = True
' Combo1.Locked = True
End Sub
Public Function Db()
Set Mydb = ExeCutesql("select * from 支出 order by key", Str_text) Set MSHFlexGrid1.DataSource = Mydb
End Function
Public Function Db1()
On Error Resume Next
Dim A As Integer
Set Mydb1 = ExeCutesql("select * from 支出项目 ", Str_text)
A = Mydb1.RecordCount
Set Combo2.DataSource = Mydb1
For I = 1 To A
Combo2.AddItem Mydb1.Fields(0)
Mydb1.MoveNext
If Mydb1.EOF Then Exit For
Next I
End Function
Public Function Db2()
On Error Resume Next
Dim A As Integer
Set Mydb2 = ExeCutesql("select * from 成员", Str_text)
A = Mydb2.RecordCount
Set Combo3.DataSource = Mydb2
For I = 1 To A
Combo3.AddItem Mydb2.Fields(0)
Mydb2.MoveNext
If Mydb2.EOF Then Exit For
Next I
Combo3.AddItem "全家"
End Function
Private Sub Form_Unload(Cancel As Integer)
'Mydb.Close
'Mydb1.Close
'Mydb2.Close
End Sub
Private Sub MSHFlexGrid1_Click()
On Error Resume Next
DTPicker1.Value = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 1) Combo1.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 2) txt_money.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 3) Combo2.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 4)
txt_intake.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 5)
Combo3.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 6)
txt_mome.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 7)
txt_note.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 8)
End Sub
Private Sub txt_money_LostFocus()
Dim A As Boolean
Dim C
C = txt_money.Text
A = IsNumeric(C)
If C = "" Then
MsgBox "请输入金额！", vbOKOnly + 32, "注意！"
txt_money.SetFocus
Else
If A = False Then
MsgBox "金额只能输入数字！", vbOKOnly + 32, "注意！"
txt_money.SetFocus
End If
End If
End Sub
Private Function Xiangmu()
Dim A
Dim Str_text As String
Dim Db As New ADODB.Recordset
Str_text = Combo2.Text
Set Db = ExeCutesql("select * from 支出项目 where value='" & Str_text & "'", "")
'MsgBox
If Not Str_text = Db.Fields(0) Then
ExeCutesql "insert into 支出项目 values('" & Str_text & "')", "" End If
End Function
Private Function Renyuan()
'Dim A
'Dim Str_text As String
'Dim Db As New ADODB.Recordset
'Str_text = Combo3.Text
'Set Db = ExeCutesql("select * from 成员 where value='" & Str_text & "'", "")
'MsgBox
'If Not Str_text = Db.Fields(0) Then
' ExeCutesql "insert into 成员 values('" & Str_text & "')", ""
'End If
End Function
6、frm_family.frm
Dim Mydb As New ADODB.Recordset
Dim Mydb1 As New ADODB.Recordset
Dim Count1 As New ADODB.Recordset
Dim Str_text As String
Private Sub cmd_add_Click()
On Error Resume Next
Dim A, B
B = 1
Set Count1 = ExeCutesql("select * from 成员 ", Str_text)
Count1.MoveLast
B = Count1.Fields(4) + 1
A = MsgBox("是否添加前记录?", vbYesNo + 32, "修改记录")
If A = vbYes Then
ExeCutesql "insert into 成员 values('" & Text1.Text & "','" & Text2.Text & "','" & Format(DTPicker1.Value, "yyyy-mm-dd") & "','" & Text3.Text & "'," & B & ") ", Str_text Call Db
Mydb.MoveLast
MsgBox "数据已经保存！", vbOKOnly + 64, "成功"
End If
End Sub
Private Sub cmd_close_Click()
Unload Me
End Sub
Private Sub cmd_del_Click()
On Error Resume Next
Dim A
A = MsgBox("是否删除当前记录", vbYesNo + 32 + 256, "删除记录") If A = vbYes Then
ExeCutesql "DELETE from 成员 where key=" & txt_key.Text & "", Str_text 'Mydb.Requery
'If Mydb.EOF Then Mydb.MoveLast
'Call Db
Set Mydb = ExeCutesql("select * from 成员", Str_text)
Set MSHFlexGrid1.DataSource = Mydb
End If
End Sub
Private Sub cmd_edit_Click()
On Error Resume Next
Dim A
A = MsgBox("是否修改前记录?", vbYesNo + 32, "修改记录")
If A = vbYes Then
ExeCutesql "Update 成员 set 称呼='" & Text1.Text & "',姓名='" & Text2.Text _
& "',生日='" & DTPicker1.Value & "',格言='" & Text3.Text & "'where key=" & txt_key.Text & "", Str_text
MsgBox "数据已经修改成功！", vbOKOnly + 64, "成功"
Call Db
End If
End Sub
Private Sub Form_Load()
Call Db
DTPicker1.Value = Date
End Sub
Private Function Db()
Set Mydb = ExeCutesql("select * from 成员", Str_text)
Set MSHFlexGrid1.DataSource = Mydb
End Function
Private Sub MSHFlexGrid1_Click()
On Error Resume Next
Text1.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 1)
Text2.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 2)
DTPicker1.Value = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 3) Text3.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 4)
txt_key.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 5)
End Sub
7、frm_fix.frm
Dim Mydb As New ADODB.Recordset
Dim Mydb1 As New ADODB.Recordset
Dim Man As New ADODB.Recordset
Dim Count1 As New ADODB.Recordset
Dim Str_text As String
Private Sub cmd_add_Click()
On Error Resume Next
Dim A, B
B = 1
Set Count1 = ExeCutesql("select key from 定期存款 ", Str_text)
Count1.MoveLast
B = Count1.Fields(0) + 1
A = MsgBox("是否添加前记录?", vbYesNo + 32, "修改记录")
If A = vbYes Then
ExeCutesql "insert into 定期存款 values('" & Format(DTPicker1.Value, "yyyy-mm-dd") & "','" & txt_name.Text _
& "','" & txt_address.Text & "','" & txt_size.Text & "'," & txt_money.Text & ",'" & txt_time.Text & "','" & Combo1.Text & "','" & Check1.Value & "'," & B & ")", Str_text Call Bangding
End If
End Sub
Private Sub cmd_del_Click()
On Error Resume Next
Dim A
A = MsgBox("是否删除当前记录？", vbYesNo + 32 + 256, "添加记录") If A = vbYes Then
ExeCutesql "DELETE from 定期存款 where key=" & txt_key.Text & "", Str_text
Call Bangding
End If
End Sub
Private Sub cmd_edit_Click()
On Error Resume Next
Dim A
A = MsgBox("是否修改前记录？", vbYesNo + 32, "添加记录")
If A = vbYes Then
ExeCutesql "Update 定期存款 Set 日期 = '" & DTPicker1.Value & "',银行名称='" & txt_name.Text _
& "',银行地址=" & txt_address.Text & ", 银行账号='" & txt_size.Text & "',金额='" & txt_money.Text _
& "',期限='" & txt_time.Text & "',存款人='" & Combo1.Text & "',取否='" & Check1.Value & "' Where key = " & txt_key.Text & " ", Str_text
'Mydb.Requery
Call Bangding
MsgBox "数据修改成功！", vbOKOnly + 64, "成功"
End If
End Sub
Private Sub cmd_quit_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim A As Integer
DTPicker1.Value = Date
Call Bangding
Set Mydb1 = ExeCutesql("select 姓名 from 成员 ", Str_text)
A = Mydb1.RecordCount
Set Combo1.DataSource = Mydb1
For I = 1 To A
Combo1.AddItem Mydb1.Fields(0)
Mydb1.MoveNext
If Mydb1.EOF Then Exit For
Next I
End Sub
Private Function Bangding()
Set Mydb = ExeCutesql("select * from 定期存款 ", Str_text) Set MSHFlexGrid1.DataSource = Mydb
End Function
Private Sub MSHFlexGrid1_Click()
On Error Resume Next
DTPicker1.Value = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 1) txt_name.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 2) txt_address.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 3) txt_size.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 4) txt_money.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 5) txt_time.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 6) Combo1.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 7) Check1.Value = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 8) txt_key.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 9)
End Sub
8、frm_intake.frm
Dim Mydb As New ADODB.Recordset
Dim Mydb1 As New ADODB.Recordset
Dim Mydb2 As New ADODB.Recordset
Dim Count1 As New ADODB.Recordset
Dim Str_text As String
Private Sub cmd_add_Click()
On Error Resume Next
Dim A, B
B = 1
Set Count1 = ExeCutesql("select * from 收入", Str_text)
Count1.MoveLast
B = Count1.Fields(7) + 1
A = MsgBox("是否添加前记录？", vbYesNo + 32, "添加记录")
If A = vbYes Then
If txt_intake.Text = "" Then
MsgBox "请填写来源！", vbOKOnly + 32, "注意"
txt_intake.SetFocus
Else
ExeCutesql "INSERT INTO 收入 VALUES('" & Format(DTPicker1.Value, "yyyy-mm-dd") & "','" _
& Combo1.Text & "'," & txt_money.Text & ",'" & Combo2.Text & "','" & txt_intake.Text _
& "','" & Combo3.Text & "','" & txt_mome.Text & "'," & B & ")", Str_text MsgBox "数据已经保存！", vbOKOnly + 64, "成功"
Call Xiangmu
Call Db
End If
End If
End Sub
Private Sub cmd_close_Click()
Unload Me
End Sub
Private Sub cmd_del_Click()
On Error Resume Next
Dim A
A = MsgBox("是否删除当前记录？", vbYesNo + 32 + 256, "添加记录") If A = vbYes Then
'Mydb.UpdateBatch
ExeCutesql "DELETE from 收入 where key=" & txt_note.Text & "", Str_text
Call Db
Set Mydb = ExeCutesql("select * from 收入 ", Str_text)
Set MSHFlexGrid1.DataSource = Mydb
End If
End Sub
Private Sub cmd_edit_Click()
'On Error Resume Next
Dim A
A = MsgBox("是否修改当前记录？", vbYesNo + 32, "添加记录")
If A = vbYes Then
ExeCutesql "Update 收入 Set 日期 = '" & Format(DTPicker1.Value, "yyyy-mm-dd") & "',方式='" & Combo1.Text & "',金额=" & txt_money.Text & ", 来源='" & txt_intake.Text & "',人员='" & Combo3.Text & "',备注='" & txt_mome.Text & "' Where key = " & txt_note.Text & " ", Str_text
Call Db
MsgBox "数据修改成功！", vbOKOnly + 64, "成功"
End If
'MsgBox "Update 收入 Set 日期 = '" & DTPicker1.Value & "',方式='" & Combo1.Text & "',金额=" & txt_money.Text & ", 来源='" & txt_intake.Text & "',人员='" & Combo3.Text & "',备注='" & txt_mome.Text & "' Where key = '" & txt_note.Text & " '"
End Sub
Private Sub Combo2_Change()
Call Db1
End Sub
Private Sub Combo3_Change()
Call Db2
End Sub
Private Sub Command1_Click()
Call Db
End Sub
Private Sub Form_Load()
Call Db
Call Db1
Call Db2
DTPicker1.Value = Date
'Combo3.Locked = True
'Combo1.Locked = True
End Sub
Public Function Db()
Set Mydb = ExeCutesql("select * from 收入 order by key ", Str_text) Set MSHFlexGrid1.DataSource = Mydb
End Function
Public Function Db1()
On Error Resume Next
Dim A As Integer
Set Mydb1 = ExeCutesql("select * from 收入项目 ", Str_text)
A = Mydb1.RecordCount
Set Combo2.DataSource = Mydb1
For I = 1 To A
Combo2.AddItem Mydb1.Fields(0)
Mydb1.MoveNext
If Mydb1.EOF Then Exit For
Next I
End Function
Public Function Db2()
On Error Resume Next
Dim A As Integer
Set Mydb2 = ExeCutesql("select * from 成员", Str_text)
A = Mydb2.RecordCount
Set Combo3.DataSource = Mydb2
For I = 1 To A
Combo3.AddItem Mydb2.Fields(0)
Mydb2.MoveNext
If Mydb2.EOF Then Exit For
Next I
Combo3.AddItem "全家"
End Function
Private Sub Form_Unload(Cancel As Integer)
'Mydb.Close
'Mydb1.Close
'Mydb2.Close
End Sub
Private Sub MSHFlexGrid1_Click()
On Error Resume Next
DTPicker1.Value = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 1) Combo1.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 2) txt_money.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 3) Combo2.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 4) txt_intake.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 5)
Combo3.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 6)
txt_mome.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 7)
txt_note.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 8)
End Sub
Private Sub txt_money_LostFocus()
Dim A As Boolean
Dim C
C = txt_money.Text
A = IsNumeric(C)
If C = "" Then
MsgBox "请输入金额！", vbOKOnly + 32, "注意！"
txt_money.SetFocus
Else
If A = False Then
MsgBox "金额只能输入数字！", vbOKOnly + 32, "注意！"
txt_money.SetFocus
End If
End If
End Sub
Private Function Xiangmu()
Dim A
Dim Str_text As String
Dim Db As New ADODB.Recordset
Str_text = Combo2.Text
Set Db = ExeCutesql("select * from 支出项目 where value='" & Str_text & "'", "")
'MsgBox
If Not Str_text = Db.Fields(0) Then
ExeCutesql "insert into 支出项目 values('" & Str_text & "')", "" End If
End Function
9、frm_list.frm
Dim Mydb As New ADODB.Recordset
Dim Mydb1 As New ADODB.Recordset
Dim Money As New ADODB.Recordset
Dim Money1 As New ADODB.Recordset
Dim Str_text As String
Private Sub Command1_Click()
frm_rate.Show
End Sub
Private Sub Command2_Click()
frm_date.Show
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Form_Activate()
On Error Resume Next
Dim A, B, C As Integer
Dim D As String
Dim Year1, Month1, Riqi, Riqi1, Riqi3, Riqi4
If AA = True Then
Set Mydb = ExeCutesql("select * from 收入 where 日期 between '" & Cdate1 & "' and '" & Cdate2 & "' ", "")
Set MSHFlexGrid1.DataSource = Mydb
Set Mydb1 = ExeCutesql("select * from 支出 where 日期 between '" & Cdate1 & "' and '" & Cdate2 & "' ", "")
Set MSHFlexGrid2.DataSource = Mydb1
Set Money = ExeCutesql("select sum(金额) from 收入 where 日期 between '" & Cdate1 & "'and '" & Cdate2 & "'", "")
A = Money.Fields(0)
If IsNull(A) Then
A = 0
End If
Label2.Caption = A
Set Money1 = ExeCutesql("select sum(金额) from 支出 where 日期 between '" & Cdate1 & "'and '" & Cdate2 & "'", "")
B = Money1.Fields(0)
If IsNull(B) Then
B = 0
End If
Label8.Caption = B
C = A - B
If C > 0 Then
D = "富裕"
Else
D = "超支"
End If
Label13.Caption = Format(Cdate1, "yyyy年mm月") & "," & "本月你" & D &
C & "元！"
Else
Year1 = Year(Now)
Month1 = Month(Now)
Riqi = Year1 & "-" & Month1
Riqi1 = Year1 & "-" & Month1 + 1
Set Mydb = ExeCutesql("select * from 收入 where 日期 between '" & Format(Riqi, "yyyy-mm") & "'and '" & Format(Riqi1, "yyyy-mm") & "'", Str_text)
Set MSHFlexGrid1.DataSource = Mydb
Set MSHFlexGrid2.DataSource = Mydb1
Set Money = ExeCutesql("select sum(金额) from 收入 where 日期 between '" & Format(Riqi, "yyyy-mm") & "'and '" & Format(Riqi1, "yyyy-mm") & "'", "")
A = Money.Fields(0)
If IsNull(A) Then
A = 0
End If
Label2.Caption = A
Set Money1 = ExeCutesql("select sum(金额) from 支出 where 日期 between '" & Format(Riqi, "yyyy-mm") & "'and '" & Format(Riqi1, "yyyy-mm") & "'", "")
B = Money1.Fields(0)
If IsNull(B) Then
B = 0
End If
Label8.Caption = B
C = A - B
If C > 0 Then
D = "富裕"
Else
D = "超支"
End If
Label13.Caption = Year(Now) & "年" & Month(Now) & "月" & "," & "本月你" & D & C & "元！"
End If
End Sub
Private Sub Form_Load()
On Error Resume Next
Dim A, B, C As Integer
Dim D As String
Dim Year1, Month1, Riqi, Riqi1, Riqi3, Riqi4
Year1 = Year(Now)
Month1 = Month(Now)
Riqi = Year1 & "-" & Month1
Riqi1 = Year1 & "-" & Month1 + 1
Set Mydb = ExeCutesql("select * from 收入 where 日期 between '" & Format(Riqi, "yyyy-mm") & "'and '" & Format(Riqi1, "yyyy-mm") & "'", Str_text)
Set MSHFlexGrid1.DataSource = Mydb
Set Mydb1 = ExeCutesql("select * from 支出 where 日期 between '" & Format(Riqi, "yyyy-mm") & "'and '" & Format(Riqi1, "yyyy-mm") & "'", Str_text)
Set MSHFlexGrid2.DataSource = Mydb1
Set Money = ExeCutesql("select sum(金额) from 收入 where 日期 between '" & Format(Riqi, "yyyy-mm") & "'and '" & Format(Riqi1, "yyyy-mm") & "'", "")
A = Money.Fields(0)
If IsNull(A) Then
A = 0
End If
Label2.Caption = A
Set Money1 = ExeCutesql("select sum(金额) from 支出 where 日期 between '" & Format(Riqi, "yyyy-mm") & "'and '" & Format(Riqi1, "yyyy-mm") & "'", "")
B = Money1.Fields(0)
If IsNull(B) Then
B = 0
End If
Label8.Caption = B
C = A - B
If C > 0 Then
D = "富裕"
Else
D = "超支"
End If
Label13.Caption = Year(Now) & "年" & Month(Now) & "月" & "," & "本月你" & D & C & "元！"
End Sub
10、frm_live.frm
Dim Mydb As New ADODB.Recordset
Dim Mydb1 As New ADODB.Recordset
Dim Mydb2 As New ADODB.Recordset
Dim Mydb3 As New ADODB.Recordset
Dim Mydb4 As New ADODB.Recordset
Dim Money As New ADODB.Recordset
Dim Key1 As New ADODB.Recordset
Dim Note As New ADODB.Recordset
Dim Count1 As New ADODB.Recordset
Dim AA As New ADODB.Recordset
Dim BB As New ADODB.Recordset
Dim Str_text As String
Dim Balance As Integer
Dim Panduan As Boolean
Dim Panduan1 As Boolean
Dim Yuen As Integer
Private Sub Combo1_Click()
Call Wangge
End Sub
Private Sub Command1_Click()
Call Atrue
txt_money.Text = ""
txt_name.Text = ""
txt_address.Text = ""
txt_man.Text = ""
txt_size.Text = ""
DTPicker1.Value = Date
Panduan1 = True
End Sub
Private Sub Command10_Click()
Unload Me
End Sub
Private Sub Command11_Click()
On Error Resume Next
Dim A, B, C, D, E, F, Key
Set Count1 = ExeCutesql("select key from 活期存取", Str_text) If Count1.EOF Then
E = Null
End If
If IsNull(E) Then
Key = 1
Else
Count1.MoveLast
Key = Count1.Fields(0) + 1
End If
Set Note = ExeCutesql("select 余额 from 活期存取 ", Str_text)
If Note.EOF Then
D = Null
End If
If IsNull(D) Then
Set Money = ExeCutesql("select 款额 from 活期帐户 where 银行帐号='" & Combo1.Text & "'", Str_text)
C = Money.Fields(0)
Balance = C
Else
Note.MoveLast
Balance = Note.Fields(0)
End If
If Len(Combo1.Text) = 0 Then
MsgBox "请选择银行账号！", vbOKOnly + 32
End If
A = MsgBox("是否添加此条记录？", vbYesNo + 32, "添加记录") If A = vbYes Then
If Panduan = True Then
Balance = Balance - CInt(Text1.Text)
ExeCutesql "insert into 活期存取 values('" & Combo1.Text & "','取款'," & Text1.Text & ",'" _
& Format(DTPicker2.Value, "yyyy-mm-dd") & "','" & Text2.Text & "','" & Balance & "','" & Key & "')", Str_text
Call Wangge
Text1.Enabled = False
Text2.Enabled = False
Text1.Text = ""
Text2.Text = ""
MsgBox "数据添加成功！", vbOKOnly, "成功"
Else
Balance = Balance + CInt(Text1.Text)
ExeCutesql "insert into 活期存取 values('" & Combo1.Text & "','存款'," & Text1.Text & ",'" _
& Format(DTPicker2.Value, "yyyy-mm-dd") & "','" & Text2.Text & "','" & Balance & "','" & Key & "')", Str_text
Call Wangge
Text1.Enabled = False
Text2.Enabled = False
Text1.Text = ""
Text2.Text = ""
MsgBox "数据添加成功！", vbOKOnly, "成功"
End If
End If
Command11.Enabled = False
End Sub
Private Sub Command12_Click()
On Error Resume Next
Mydb.MoveNext
If Mydb.EOF Then
Mydb.MoveLast
End If
End Sub
Private Sub Command13_Click()
On Error Resume Next
Mydb.MovePrevious
If Mydb.BOF Then
Mydb.MoveFirst
End If
End Sub
Private Sub Command2_Click()
Call Atrue
Panduan1 = False
End Sub
Private Sub Command3_Click()
Dim A
A = MsgBox("是否删除当前记录？", vbYesNo + 32 + 256, "删除记录") If A = vbYes Then
If Mydb.EOF Then
Call Bangding
Exit Sub
Else
Mydb.Delete
End If
End If
Call Bangding
End Sub
Private Sub Command4_Click()
Unload Me
End Sub
Private Sub Command5_Click()
Dim A, B
If Panduan1 = True Then
A = MsgBox("是否添加此记录？", vbYesNo + 32, "")
If A = vbYes Then
ExeCutesql "insert into 活期帐户 values('" & Format(DTPicker1.Value, "yyyy-mm-dd") & "','" _
& txt_name.Text & "','" & txt_address.Text & "','" & txt_size.Text _ & "'," & CCur(txt_money.Text) & " ,'" & txt_man.Text & "') ", Str_text Call Bangding
Call Afalse
End If
Else
B = MsgBox("是否修改前记录？", vbYesNo + 32, "添加记录")
If B = vbYes Then
ExeCutesql "Update 活期帐户 Set 开户日期 ='" & Format(DTPicker1.Value, "yyyy-mm-dd") & "',银行名称='" _
& txt_name.Text & "',银行地址='" & txt_address.Text & "',银行帐号 ='" & txt_size.Text _
& "',款额=" & CCur(txt_money.Text) & " ,开户人='" & txt_man.Text & "'", Str_text
Call Bangding
Call Afalse
MsgBox "Update 活期帐户 Set 开户日期 ='" & Format(DTPicker1.Value, "yyyy-mm-dd") & "',银行名称='" _
& txt_name.Text & "',银行地址='" & txt_address.Text & "',银行帐号 ='" & txt_size.Text _
& "',款额=" & CCur(txt_money.Text) & " ,开户人='" & txt_man.Text & "'" MsgBox "数据修改成功！", vbOKOnly + 64, "成功"
End If
End If
End Sub
Private Sub Command6_Click()
Panduan = True
Command11.Enabled = True
Text1.Enabled = True
Text2.Enabled = True
End Sub
Private Sub Command7_Click()
Panduan = False
Command11.Enabled = True
Text1.Enabled = True
Text2.Enabled = True
End Sub
Private Sub Command9_Click()
On Error Resume Next
Dim A, B, C, I, Ab, Bc, CC
Bc = CInt(txt_key.Text)
Set AA = ExeCutesql("select key from 活期存取", Str_text)
If AA.EOF Then
Exit Sub
End If
AA.MoveLast
C = AA.Fields(0)
B = C - Bc
A = MsgBox("是否删除当前记录？", vbYesNo + 32 + 256, "添加记录") If A = vbYes Then
ExeCutesql "delete from 活期存取 where key=" & txt_key.Text & " ", Str_text
For I = Bc To C
Set BB = ExeCutesql("select 余额 from 活期存取 where key=" & I & " ", Str_text)
'If BB.EOF Then Exit Sub
Ab = BB.Fields(0)
CC = Ab - CInt(Text1.Text)
'MsgBox CC
ExeCutesql "update 活期存取 set 余额=" & CC & " where key = " & I & "", Str_text
'MsgBox "update 活期存取 set 余额=" & CC & " where key = " & I & ""
Next I
Call Wangge
Call MSHFlexGrid1_Click
End If
End Sub
Private Sub Form_Load()
On Error Resume Next
Dim A As Integer
Set Mydb3 = ExeCutesql("select sum(数目) from 活期存取", Str_text) Balance = Mydb3.Fields(0)
Call Bangding
Call Afalse
Command11.Enabled = False
Text1.Enabled = False
Text2.Enabled = False
DTPicker1.Value = Date
DTPicker2.Value = Date
End Sub
Private Sub MSHFlexGrid1_Click()
On Error Resume Next
DTPicker2.Value = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 1) Text1.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 4) Text2.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 2) txt_key.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 6) 'Yuen = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 5)
End Sub
Private Sub SSTab1_Click(PreviousTab As Integer)
On Error Resume Next
Dim A As Integer
If SSTab1.Caption = "取款记录" Then
Set Mydb1 = ExeCutesql("select 银行帐号 from 活期帐户", Str_text)
A = Mydb1.RecordCount
For I = 1 To A
Combo1.AddItem Mydb1.Fields(0)
Mydb1.MoveNext
If Mydb1.EOF Then Exit For
Next I
End If
End Sub
Private Sub Text1_LostFocus()
Dim A As Boolean
Dim C
C = Text1.Text
A = IsNumeric(C)
If C = "" Then
MsgBox "请输入金额！", vbOKOnly + 32, "注意！"
Text1.SetFocus
Else
If A = False Then
MsgBox "金额只能输入数字！", vbOKOnly + 32, "注意！" Text1.SetFocus
End If
End If
End Sub
Private Sub txt_money_LostFocus()
Dim A As Boolean
Dim C
C = txt_money.Text
A = IsNumeric(C)
If C = "" Then
MsgBox "请输入金额！", vbOKOnly + 32, "注意！" txt_money.SetFocus
Else
If A = False Then
MsgBox "金额只能输入数字！", vbOKOnly + 32, "注意！" txt_money.SetFocus
End If
End If
End Sub
Private Function Bangding()
On Error Resume Next
Set Mydb = ExeCutesql("select * from 活期帐户", Str_text) Mydb.MoveFirst
Set txt_date.DataSource = Mydb
Set txt_money1.DataSource = Mydb
Set txt_name1.DataSource = Mydb
Set txt_address1.DataSource = Mydb
Set txt_man1.DataSource = Mydb
Set txt_size1.DataSource = Mydb
txt_date.DataField = "开户日期"
txt_money1.DataField = "款额"
txt_name1.DataField = "银行名称"
txt_address1.DataField = "银行地址"
txt_man1.DataField = "开户人"
txt_size1.DataField = "银行帐号"
Label21.Caption = Mydb.RecordCount
End Function
Private Function Atrue()
txt_money.Locked = False
txt_name.Locked = False
txt_address.Locked = False
txt_man.Locked = False
txt_size.Locked = False
Command5.Enabled = True
End Function
Private Function Afalse()
txt_money.Locked = True
txt_name.Locked = True
txt_address.Locked = True
txt_man.Locked = True
txt_size.Locked = True
Command5.Enabled = False
End Function
Private Function Wangge()
Set Mydb2 = ExeCutesql("select 日期, 姓名, 存取,数目,余额,key from 活期存取 where 帐号='" & Combo1.Text & "'", Str_text)
Set MSHFlexGrid1.DataSource = Mydb2
End Function
11、frm_login.frm
Dim Mydb As New ADODB.Recordset
Dim Mydb1 As New ADODB.Recordset
Dim Str_text As String
Private Sub Command1_Click()
On Error Resume Next
Static I As Integer '记数器
Static L As Integer '记数器
Dim Str_name As String
Dim Str_password As String
Dim Str_username As String
Dim Str_userpassword As String
Dim Remainday As Long
Str_name = txt_name.Text
Str_password = txt_password.Text
Set Mydb = ExeCutesql("select user from user1 where user='" & Str_name & "'", Str_text)
If Mydb.EOF Then
MsgBox "你输入的用户名不存在，请重新输入！", vbOKOnly + 32, "注意" L = L + 1
txt_name.SetFocus
If L = 5 Then
MsgBox "你已经多次输入错误的用户名,请查证后重新登陆！", vbOKOnly + 48, "注意"
End
End If
Exit Sub
Else
Set Mydb1 = ExeCutesql("select user,pass from user1 where user='" & Str_name & "'", Str_text)
Str_username = Trim(Mydb1.Fields(0))
Str_userpassword = Trim(Mydb1.Fields(1))
If Trim(Str_password) = Str_userpassword Then
frm_main.Show
Mydb.Close
Mydb1.Close
Set Mydb = Nothing
Set Mydb1 = Nothing
Unload Me
Else
MsgBox "你输入的密码错误，请重新输入！", vbOKOnly + 32, "注意" I = I + 1
txt_password.SetFocus
If I = 3 Then
MsgBox "你输入的密码三次都不正确，本系统将关闭！", vbOKOnly + 48, "注意"
End
End If
Exit Sub
End If
End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub txt_name_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then txt_password.SetFocus
End Sub
Private Sub txt_password_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Command1.SetFocus
End Sub
Private Sub txt_name_LostFocus()
Cname = txt_name.Text
End Sub
12、frm_main.frm
Private Sub mnu_cx_shouru_Click()
frm_query.Show 0, frm_main End Sub
Private Sub mnu_bz_zt_Click()
End Sub
Private Sub mnu_cx_Click()
frm_query.Show 0, frm_main End Sub
Private Sub mnu_rcgl_dq_Click()
frm_fix.Show 0, frm_main End Sub
Private Sub mnu_rcgl_hq_Click()
frm_live.Show 0, frm_main End Sub
Private Sub mnu_rcgl_jc_Click()
frm_borrowgo.Show 0, frm_main End Sub
Private Sub mnu_rcgl_jr_Click()
frm_borrowin.Show 0, frm_main End Sub
Private Sub mnu_rcgl_sr_Click()
frm_intake.Show 0, frm_main End Sub
Private Sub mnu_rcgl_zc_Click()
frm_expend.Show 0, frm_main End Sub
Private Sub mnu_xt_shz_Click()
frm_login.Show
Unload Me
End Sub
Private Sub mnu_xt_xg_Click()
frm_password.Show 0, frm_main
End Sub
Private Sub mnu_xy_family_Click()
frm_family.Show 0, frm_main
End Sub
Private Sub mnuexit_Click()
Unload Me
End Sub
Private Sub mnuinput_Click()
Call FileIn
End Sub
Private Sub mnuout_Click()
Call FileGo
End Sub
Private Function FileGo()
On Error GoTo 1
Dim A, B As String
CommonDialog1.ShowSave
A = CommonDialog1.FileName
B = App.Path & "\" & "database\MoneyMIS.mdb" Set fs = CreateObject("Scripting.FileSystemObject") fs.CopyFile B, A
MsgBox "数据库导出成功！", vbOKOnly + 64, "成功" Exit Function
1:
MsgBox "数据库导出失败！", vbOKOnly + 64, "失败" End Function
Private Function FileIn()
On Error GoTo 1
Dim A, B, C, D As String
C = MsgBox("是否真的导入数据库，导入新数据库后，将覆盖原来的所有录？", vbYesNo + 48 + 256, "警告")
If C = vbYes Then
CommonDialog1.ShowOpen
A = CommonDialog1.FileName
B = App.Path & "\" & "database\MoneyMIS.mdb"
'D = CurDir() & "\" & "MoneyMIS.mdb"
Set Fs1 = CreateObject("Sfcripting.FileSystemObject")
'Fs1.DeleteFile D, True
Fs1.CopyFile A, B
MsgBox "数据库导入成功！", vbOKOnly + 64, "成功"
Else
MsgBox "数据库导入失败！", vbOKOnly + 64, "失败"
End If
Exit Function
1:
MsgBox "数据库导入失败！", vbOKOnly + 64, "失败"
End Function
13、frm_passward.frm
Dim Mydb As New ADODB.Recordset
Dim Str_text As String
Private Sub Command1_Click()
On Error Resume Next
Dim Password As String
Dim Newpassword As String
Password = Text1.Text
Newpassword = Text2.Text
Set Mydb = ExeCutesql("SELECT pass from user1 WHERE user='" & Cname & "'", Str_text)
'MsgBox "select pass from user1 where user='" & Cname & "'"
If Not Password = Mydb.Fields(0) Then
MsgBox "原密码输入错误！", vbOKOnly + 32, "注意"
Text2.Text = ""
Text3.Text = ""
Text2.SetFocus
Else
If Text3.Text <> Newpassword Then
MsgBox "你两次输入密码不一致，请重新输入！", vbOKOnly + 32, "注意"
Text1.SetFocus
Else
ExeCutesql "UPDATE user1 SET pass= '" & Newpassword & "' where user='" & Cname & "'", ""
MsgBox "密码更改成功！", vbOKOnly + 64, "注意"
Unload Me
End If
End If
End Sub
Private Sub Command2_Click()
Unload Me
frm_main.Show
End Sub
14、frm_project.frm
Dim Mydb1 As ADODB.Recordset
Dim Mydb2 As ADODB.Recordset
Dim Mydb3 As ADODB.Recordset
Dim Mydb4 As ADODB.Recordset
Dim Str_text As String
'
Private Function Db1()
Set Mydb1 = ExeCutesql("select * from 收入项目", Str_text)
Set MSHFlexGrid1.DataSource = Mydb1
End Function
Private Function Db2()
Set Mydb2 = ExeCutesql("select * from 支出项目", Str_text)
Set MSHFlexGrid2.DataSource = Mydb2
End Function
Private Sub cmd_add_Click()
Text1.Locked = False
End Sub
Private Sub cmd_cancel_Click()
Unload Me
End Sub
Private Sub cmd_del_Click()
On Error Resume Next
Dim A As Boolean
Set Mydb3 = ExeCutesql("select * from 收入项目 where value='" & Text1.Text & "' ", Str_text)
If SSTab1.Tab = 0 Then
A = MsgBox("是否删除当前记录", vbYesNo + 32 + 256, "删除记录") If A = True Then
Mydb3.Delete
Mydb3.MoveNext
If Mydb3.EOF Then Mydb.MoveLast
Mydb3.Requery
Call Db1
End If
Else
Set Mydb4 = ExeCutesql("select * from 支出项目 where value='" & Text1.Text & "' ", Str_text)
A = MsgBox("是否删除当前记录", vbYesNo + 32 + 256, "删除记录") If A = True Then
Mydb4.Delete
Mydb4.MoveNext
If Mydb4.EOF Then Mydb2.MoveLast
Mydb4.Requery
Call Db2
End If
End If
End Sub
Private Sub cmd_save_Click()
On Error Resume Next
Dim A As Boolean
If SSTab1.Tab = 0 Then
A = MsgBox("是否添加前记录?", vbYesNo + 32, "添加记录") If A = True Then
ExeCutesql "insert into 收入项目 values('" & Text1.Text & "')", Str_text
Mydb1.MoveLast
Call Db1
MsgBox "收入项目添加成功！", vbOKOnly + 64, ""
Text1.Text = ""
End If
Else
A = MsgBox("是否添加前记录?", vbYesNo + 32, "添加记录") If A = True Then
ExeCutesql "insert into 支出项目 values('" & Text1.Text & "')",
Str_text
Mydb2.MoveLast
Call Db2
MsgBox "支出项目添加成功！", vbOKOnly + 64, "" Text1.Text = ""
End If
End If
End Sub
Private Sub Form_Load()
Text1.Locked = True
Call Db1
Call Db2
End Sub
Private Sub MSHFlexGrid1_Click()
Text1.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 1) End Sub
Private Sub MSHFlexGrid2_Click()
Text1.Text = MSHFlexGrid2.TextMatrix(MSHFlexGrid2.Row, 1)
End Sub
15、frm_query.frm
Dim Mydb As New ADODB.Recordset
Dim Mydb1 As New ADODB.Recordset
Dim Mydb2 As New ADODB.Recordset
Dim Mydb3 As New ADODB.Recordset
Dim Mydb4 As New ADODB.Recordset
Dim Mydb5 As New ADODB.Recordset
Dim Mydb10 As New ADODB.Recordset
Dim Mydb11 As New ADODB.Recordset
Dim Mydb12 As New ADODB.Recordset
Dim Str_text As String
Dim Riqi, Riqi1, Riqi3, Riqi4
Private Sub Chk_date1_Click()
If Chk_date1.Value = 1 Then
Chk_mode1.Value = 0
Chk_money1.Value = 0
Chk_project1.Value = 0
End If
End Sub
Private Sub Chk_mode1_Click()
If Chk_mode1.Value = 1 Then Chk_money1.Value = 0 Chk_project1.Value = 0 Chk_date1.Value = 0 End If
End Sub
Private Sub Chk_money1_Click()
If Chk_money1.Value = 1 Then Chk_mode1.Value = 0 Chk_project1.Value = 0 Chk_date1.Value = 0 End If
End Sub
Private Sub Chk_project1_Click()
If Chk_project1.Value = 1 Then Chk_mode1.Value = 0 Chk_date1.Value = 0 Chk_money1.Value = 0 End If
End Sub
Private Sub Command1_Click()
If Chk_date.Value = 1 Then Call Criqi
End If
If Chk_mode.Value = 1 Then Call Mode
End If
If Chk_money = 1 Then Call Money
End If
If Chk_project.Value = 1 Then Call Project
End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
If Chk_date1.Value = 1 Then
Call Criqi1
End If
If Chk_mode1.Value = 1 Then
Call Mode1
End If
If Chk_money1 = 1 Then
Call Money1
End If
If Chk_project1.Value = 1 Then
Call Project1
End If
End Sub
Private Sub Command4_Click()
Unload Me
End Sub
Private Function Criqi()
Riqi = Format(DTPicker1.Value, "yyyy-mm-dd")
Riqi1 = Format(DTPicker2.Value, "yyyy-mm-dd")
Set Mydb = ExeCutesql("select * from 收入 where 日期 between '" & Riqi & "'and '" & Riqi1 & "'", Str_text)
Set MSHFlexGrid1.DataSource = Mydb
End Function
Private Function Mode()
Set Mydb1 = ExeCutesql("select * from 收入 where 方式='" & Combo1.Text & "'", Str_text)
Set MSHFlexGrid1.DataSource = Mydb1
End Function
Private Function Money()
On Error Resume Next
Set Mydb2 = ExeCutesql("select * from 收入 where 金额=" & txt_money.Text, Str_text)
Set MSHFlexGrid1.DataSource = Mydb2
End Function
Private Function Project()
Set Mydb3 = ExeCutesql("select * from 收入 where 项目='" & Combo2.Text & "'", Str_text)
Set MSHFlexGrid1.DataSource = Mydb3
End Function
Private Sub Form_Load()
On Error Resume Next
Dim A, B
Set Mydb4 = ExeCutesql("select * from 收入项目", Str_text)
A = Mydb4.RecordCount
For I = 1 To A
Combo2.AddItem Mydb4.Fields(0)
Mydb4.MoveNext
If Mydb4.EOF Then Exit For
Next I
Set Mydb5 = ExeCutesql("select * from 支出项目", Str_text)
B = Mydb5.RecordCount
For I = 1 To B
Combo4.AddItem Mydb5.Fields(0)
Mydb5.MoveNext
If Mydb5.EOF Then Exit For
Next I
DTPicker1.Value = Date
DTPicker2.Value = Date
DTPicker3.Value = Date
DTPicker4.Value = Date
End Sub
Private Function Criqi1()
Riqi3 = Format(DTPicker3.Value, "yyyy-mm-dd")
Riqi4 = Format(DTPicker4.Value, "yyyy-mm-dd")
Set Mydb10 = ExeCutesql("select * from 支出 where 日期 between'" & Riqi3 & "' and '" & Riqi4 & "'", Str_text)
Set MSHFlexGrid2.DataSource = Mydb10
End Function
Private Function Mode1()
Set Mydb1 = ExeCutesql("select * from 支出 where 方式='" & Combo3.Text & "'", Str_text)
Set MSHFlexGrid2.DataSource = Mydb1
End Function
Private Function Money1()
On Error Resume Next
Set Mydb11 = ExeCutesql("select * from 支出 where 金额=" & txt_money1.Text, Str_text)
Set MSHFlexGrid2.DataSource = Mydb11
End Function
Private Function Project1()
Set Mydb12 = ExeCutesql("select * from 支出 where 项目='" & Combo4.Text & "'", Str_text)
Set MSHFlexGrid2.DataSource = Mydb12
End Function
Private Sub Chk_date_Click()
If Chk_date.Value = 1 Then
Chk_mode.Value = 0
Chk_money.Value = 0
Chk_project.Value = 0
End If
End Sub
Private Sub Chk_mode_Click()
If Chk_mode.Value = 1 Then
Chk_money.Value = 0
Chk_project.Value = 0
Chk_date.Value = 0
End If
End Sub
Private Sub Chk_money_Click()
If Chk_money.Value = 1 Then
Chk_mode.Value = 0
Chk_project.Value = 0
Chk_date.Value = 0
End If
End Sub
Private Sub Chk_project_Click()
If Chk_project.Value = 1 Then
Chk_mode.Value = 0
Chk_date.Value = 0
Chk_money.Value = 0
End If
End Sub
16、frm_rate.frm
Dim Mydb As New ADODB.Recordset
Dim Mydb1 As New ADODB.Recordset
Dim Mydb3 As New ADODB.Recordset
Dim Mydb4 As New ADODB.Recordset
Dim Str_text As String
Private Sub Command1_Click()
Dim A, B As Integer
Set Mydb4 = ExeCutesql("select sum(金额) from 支出", "")
A = Mydb4.Fields(0)
Set Mydb3 = ExeCutesql("select 人员,sum(金额) as 金额,str(cint(sum(金额)/'" &
A & "'*100)) & '%' as 百分比 from 支出 group by 人员 ", Str_text)
Mydb3.Requery
Set MSHFlexGrid2.DataSource = Mydb3
Command2.Enabled = True
Command1.Enabled = False
B = Mydb3.RecordCount
MSChart2.ColumnCount = B
MSChart2.ColumnLabel = Mydb3.Fields(0)
End Sub
Private Sub Command2_Click()
Dim B, C As Integer
Set Mydb4 = ExeCutesql("select sum(金额) from 支出", "")
B = Mydb4.Fields(0)
Set Mydb3 = ExeCutesql("select 项目,sum(金额) as 金额,str(cint(sum(金额)/'" &
B & "'*100)) & '%' as 百分比 from 支出 group by 项目 ", Str_text)
Set MSHFlexGrid2.DataSource = Mydb3
Command2.Enabled = False
Command1.Enabled = True
C = Mydb3.RecordCount
MSChart2.ColumnCount = C
MSChart2.ColumnLabel = Mydb3.Fields(0)
End Sub
Private Sub Command3_Click()
Dim A, B As Integer
Set Mydb1 = ExeCutesql("select sum(金额) from 收入", "")
A = Mydb1.Fields(0)
Set Mydb = ExeCutesql("select 人员,sum(金额) as 金额,str(cint(sum(金额)/'" &
A & "'*100)) & '%' as 百分比 from 收入 group by 人员 ", Str_text)
Mydb.Requery
Set MSHFlexGrid1.DataSource = Mydb
Command3.Enabled = False
Command4.Enabled = True
B = Mydb.RecordCount
MSChart1.ColumnCount = B
MSChart1.ColumnLabel = Mydb.Fields(0)
End Sub
Private Sub Command4_Click()
Dim A, C As Integer
Set Mydb1 = ExeCutesql("select sum(金额) from 收入", "")
A = Mydb1.Fields(0)
Set Mydb = ExeCutesql("select 项目,sum(金额) as 金额,str(cint(sum(金额)/'" &
A & "'*100)) & '%' as 百分比 from 收入 group by 项目 ", Str_text)
Set MSHFlexGrid1.DataSource = Mydb
Command4.Enabled = False
Command3.Enabled = True
C = Mydb.RecordCount
MSChart1.ColumnCount = C
MSChart1.ColumnLabel = Mydb.Fields(0)
End Sub
Private Sub Command5_Click()
Unload Me
End Sub
Private Sub Command6_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim A, B, C, D As Integer
Command4.Enabled = False
Command2.Enabled = False
Set Mydb1 = ExeCutesql("select sum(金额) from 收入", "")
A = Mydb1.Fields(0)
Set Mydb = ExeCutesql("select 项目,sum(金额) as 金额,str(cint(sum(金额)/'" &
A & "'*100)) & '%' as 百分比 from 收入 group by 项目 ", Str_text)
Set MSHFlexGrid1.DataSource = Mydb
Set Mydb4 = ExeCutesql("select sum(金额) from 支出", "")
B = Mydb4.Fields(0)
Set Mydb3 = ExeCutesql("select 项目,sum(金额) as 金额,str(cint(sum(金额)/'" &
B & "'*100)) & '%' as 百分比 from 支出 group by 项目 ", Str_text)
Set MSHFlexGrid2.DataSource = Mydb3
Label1.Caption = Year(Now) & "年" & Month(Now) & "月" & ":"
Label6.Caption = A & "元"
Label7.Caption = B & "元"
MSChart1.RowCount = 1
MSChart2.RowCount = 1
MSChart1.RowLabel = "收入情况"
MSChart2.RowLabel = "支出情况"
C = Mydb.RecordCount
D = Mydb3.RecordCount
If C > 0 Then
MSChart1.ColumnCount = C
MSChart1.ColumnLabel = Mydb.Fields(0)
End If
If D > 0 Then
MSChart2.ColumnCount = D
MSChart2.ColumnLabel = Mydb3.Fields(0)
End If
End Sub
17、module1.bas
Public Str_path As String
Public Cname As String '登陆时传用户名
Public Cdate1 As String '传日期(收入情况列表)
Public Cdate2 As String '传日期
Public AA As Boolean '判断是否选择月份
'ADO编程模型连接数据库
Public Function Connectstring() As String
'Dim Str_path As String
Str_path = App.Path & "\" & "database\MoneyMIS.mdb"
Connectstring = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" & Str_path & "';Persist Security Info=False"
End Function
'ADO编程模型连接数据库
Public Function ExeCutesql(ByVal Sql As String, Msgstring As String) As ADODB.Recordset Dim Cnn As ADODB.Connection
Dim Rst As ADODB.Recordset
Dim Stokens() As String '数组
' On Error GoTo executesql_error
Stokens = Split(Sql) '将sql语句按关键字保存在数组中
Set Cnn = New ADODB.Connection
Cnn.Open Connectstring
If InStr("INSERT,DELETE,UPDATE", UCase$(Stokens(0))) Then
Cnn.Execute Sql
Msgstring = Stokens(0) & "查询成功"
Else
Set Rst = New ADODB.Recordset
Rst.Open Trim$(Sql), Cnn, adOpenKeyset, adLockOptimistic '重服务器中提取符合要求的记录集
Set ExeCutesql = Rst
Msgstring = "查询到" & Rst.RecordCount & "条记录"
End If
executesql_exit:
Set Rst = Nothing '释放记录集
Set Cnn = Nothing '释放连接语句
Exit Function
executesql_error:
Msgstring = "查询错误:" & Err.Description
Resume executesql_exit
End Function