《家庭财务管理系统课程设计的原代码.doc》由会员分享，可在线阅读，更多相关《家庭财务管理系统课程设计的原代码.doc（47页珍藏版）》请在三一文库上搜索。
1、1、frm_borrowgo.frmDim Mydb As New ADODB.RecordsetDim Mydb1 As New ADODB.RecordsetDim Str_text As StringDim strflag As StringPrivate 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.
2、Text = txt_way.Text = txt_money.Text = Combo1.Text = strflag = 添加 Cmdsave.Enabled = TrueEnd SubPrivate Sub cmd_close_Click() Unload MeEnd SubPrivate Sub cmd_del_Click() Dim A As Boolean A = MsgBox(是否真的要删除这条记录？, vbOKCancel + 32 + 256, 删除) If A = True Then ExeCutesql delete from 借出 where 得款人= & txt_ma
3、n.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 IfEnd SubPrivate Sub cmd_edit_Click() On Error Resume Next Dim A As Boolean txt_man.Locked = False txt_way.Locked = False
4、 txt_money.Locked = False Combo1.Locked = False Check1.Enabled = True DTPicker1.Enabled = True strflag = 修改 Cmdsave.Enabled = TrueEnd SubPrivate Sub Cmdsave_Click() On Error Resume Next Dim A As Boolean If strflag = 添加 Then A = MsgBox(是否添加前记录？, vbYesNo + 32, 添加记录) If A = True Then ExeCutesql insert
5、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 =
6、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 = FalseEnd SubPrivate Sub Combo1_Change() Dim A As Inte
7、ger 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 IEnd SubPrivate Sub Command1_Click() On Error Resume Next Call Db Mydb.MoveFirst Call BangdingEnd S
8、ubPrivate 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 BangdingEnd SubPrivate Sub Command3_Click() On Error Resume Next Call Db Mydb.MovePrevious If Mydb.BO
9、F Then MsgBox 这已经是第一条记录了！, vbOKOnly + 32, 注意 Mydb.MoveFirst End If Mydb.MoveNext If Mydb.EOF Then MsgBox 这已经是最后一条记录了！, vbOKOnly + 32, 注意 Mydb.MoveLast End If Call BangdingEnd SubPrivate Sub Command4_Click() On Error Resume Next Call Db Mydb.MoveLast Call BangdingEnd SubPrivate Sub Form_Load() On Err
10、or 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 DTP
11、icker1.Enabled = FalseEnd SubPrivate Function Db() On Error Resume Next Set Mydb = ExeCutesql(select * from 借出, Str_text)End FunctionPrivate Function Bangding() On Error Resume Next Set txt_man.DataSource = Mydb Set txt_money.DataSource = Mydb Set DTPicker1.DataSource = Mydb Set txt_way.DataSource =
12、 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 Function2、frm_borromin.frmDim Mydb As New ADODB.RecordsetDim Mydb1 As New ADODB.RecordsetDim
13、Str_text As StringDim strflag As StringPrivate Sub cmd_close_Click() Unload MeEnd SubPrivate 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 =
14、Combo1.Text = strflag = 添加 Cmdsave.Enabled = TrueEnd SubPrivate 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 M
15、ydb.EOF Then Mydb.MoveLast Call Db Call Bangding Label7.Caption = Mydb.RecordCount End If End IfEnd SubPrivate 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.Enabl
16、ed = True strflag = 修改 Cmdsave.Enabled = TrueEnd SubPrivate 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(DT
17、Picker1.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 数据修改成功！, vbOKOn
18、ly + 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 = FalseEnd SubPrivate Sub Combo1_Change() Set Mydb1 = ExeCutesql(select 姓名 from 成员, Str_text) Set Combo1.DataSource = My
19、db1 For I = 1 To Mydb1.RecordCount Combo1.AddItem (Mydb1.Fields(0) Mydb1.MoveNext If Mydb1.EOF Then Exit For Next IEnd SubPrivate Sub Command1_Click() On Error Resume Next Call Db Mydb.MoveFirst Call BangdingEnd SubPrivate Sub Command3_Click() On Error Resume Next Call Db Mydb.MoveNext If Mydb.EOF T
20、hen MsgBox 这已经是最后一条记录了！, vbOKOnly + 32, 注意 Mydb.MoveLast End If Call BangdingEnd SubPrivate Sub Command2_Click() On Error Resume Next Mydb.MovePrevious If Mydb.BOF Then MsgBox 这已经是第一条记录了！, vbOKOnly + 32, 注意 Mydb.MoveFirst End If Call BangdingEnd SubPrivate Sub Command4_Click() On Error Resume Next C
21、all Db Mydb.MoveLast Call BangdingEnd SubPrivate 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 Check
22、1.Enabled = False DTPicker1.Enabled = FalseEnd SubPrivate Function Db() Set Mydb = ExeCutesql(select * from 借入, Str_text)End FunctionPrivate Function Bangding() On Error Resume Next Set txt_man.DataSource = Mydb Set txt_money.DataSource = Mydb Set DTPicker1.DataSource = Mydb Set txt_way.DataSource =
23、 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 Function3、frm_choose.frmPrivate Sub cmd_choose_Click() On Error Resume Next CommonDialog1
24、.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 SubPrivate Sub cmd_ok_Click() On E
25、rror Resume Next Str_path = Text1.Text SaveSetting 小财迷, personal, 路径, Str_path frm_login.Show Unload MeEnd Sub4、frm_date.frmDim Mydb As New ADODB.RecordsetDim Riqi, Riqi1, Year1, Month As StringPrivate Sub Command1_Click() Dim Riqi, Riqi1, Year, Month As String If Combo1.Text = Then MsgBox 请选择年份！, v
26、bOKOnly + 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(
27、Riqi, yyyy-mm) Cdate2 = Format(Riqi1, yyyy-mm) Unload Me End If End If End SubPrivate Sub Form_Load() Dim A As Integer A = 2000 For I = 2000 To Int(Year(Now) Combo1.AddItem A A = A + 1 Next IEnd Sub5、frm_expend.frmDim Mydb As New ADODB.RecordsetDim Mydb1 As New ADODB.RecordsetDim Mydb2 As New ADODB.
28、RecordsetDim Count1 As New ADODB.RecordsetDim Str_text As StringPrivate 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 =
29、 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 X
30、iangmu Call Db End If End If End SubPrivate Sub cmd_close_Click() Unload MeEnd SubPrivate 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(s
31、elect * from 支出 , Str_text) Set MSHFlexGrid1.DataSource = Mydb End IfEnd SubPrivate 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.T
32、ext & , 去向= & 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 SubPrivate Sub Combo2_Change() Call Db1End SubPrivate Sub Combo3_Change() Call Db2End SubPrivate Sub Form_Load() Call
33、 Db Call Db1 Call Db2 DTPicker1.Value = Date Combo3.Locked = True Combo1.Locked = TrueEnd SubPublic Function Db() Set Mydb = ExeCutesql(select * from 支出 order by key, Str_text) Set MSHFlexGrid1.DataSource = MydbEnd FunctionPublic Function Db1() On Error Resume Next Dim A As Integer Set Mydb1 = ExeCu
34、tesql(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 IEnd FunctionPublic Function Db2() On Error Resume Next Dim A As Integer Set Mydb2 = ExeCutesql(select * from 成员, Str_
35、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 FunctionPrivate Sub Form_Unload(Cancel As Integer) Mydb.Close Mydb1.Close Mydb2.CloseEnd SubPrivate Sub MSHFlexGrid1_Click() O
36、n 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