家庭财务管理系统课程设计的原代码

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 +

3、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.

4、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.Enabled = True strflag = "修改" Cmdsave.Enabled = Tru

5、eEnd 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_m

6、oney.Text & "','" & Combo1.Text & "','" & DTPicker1.Value & "','" & txt_way.Text & "','" & Check1.Value & "')", Str_text MsgBox "数据已经保存！", vbOKOnly + 64, "成功"

7、 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 = Fal

8、se 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 Integer Set Mydb1 = ExeCutesql("select 姓名 from 成员", Str_text)' Set Combo1.DataSource = Mydb1 A = Mydb1

9、.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 SubPrivate Sub Command2_Click() On Error Resume Next 'Call Db 'If Not Mydb.BOF Then

10、 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.BOF Then ' MsgBox "这已经是第一条记录了！&quo

11、t;, 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 SubP

12、rivate 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 = T

13、rue Combo1.Locked = True Check1.Enabled = False DTPicker1.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

14、= 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 = M

15、ydb Combo1.DataField = "出借人"End Function2、frm_borromin.frmDim Mydb As New ADODB.RecordsetDim Mydb1 As New ADODB.RecordsetDim 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_mo

16、ney.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 = TrueEnd SubPrivate Sub cmd_del_Click() Dim A As Boolean

17、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.EO

18、F 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.Enabled = T

19、rue 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_

20、man.Text & "','" & txt_money.Text & "','" & Combo1.Text & "','" & Format(DTPicker1.Value, "yyyy-mm-dd") & "','" & txt_way.Text & "','" & Check1.Value & &quo

21、t;')", 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 &quo

22、t;数据修改成功！", 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 = FalseEnd SubPrivate Sub Combo1_Change() Set Mydb1 = ExeCutesql("select 姓名 from

23、 成员", 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 IEnd SubPrivate Sub Command1_Click() On Error Resume Next ' Call Db Mydb.MoveFirst Call BangdingEnd SubPrivate Sub Command3_Click(

24、) On Error Resume Next 'Call Db Mydb.MoveNext If Mydb.EOF Then 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 + 3

25、2, "注意" Mydb.MoveFirst End If Call BangdingEnd SubPrivate Sub Command4_Click() On Error Resume Next 'Call 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 D

26、TPicker1.Value = Date txt_man.Locked = True txt_way.Locked = True txt_money.Locked = True Combo1.Locked = True Check1.Enabled = False DTPicker1.Enabled = FalseEnd SubPrivate Function Db() Set Mydb = ExeCutesql("select * from 借入", Str_text)End FunctionPrivate Function Bangding() On Error Re

27、sume 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 = "出

28、借原因" Check1.DataField = "已还" Set Combo1.DataSource = Mydb Combo1.DataField = "出借人"End Function3、frm_choose.frmPrivate Sub cmd_choose_Click() On Error Resume Next CommonDialog1.Filter = "database(*.mdb)|*.mdb" CommonDialog1.ShowOpen Str_path = CommonDialog1.FileName

29、 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 Error Resume Next Str_path = Te

30、xt1.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 = "&quo

31、t; 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 & "-" &a

32、mp; 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

33、 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.RecordsetDim Count1 As New ADODB.RecordsetDim Str_tex

34、t 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 = "" The

35、n MsgBox "请填写去向！", vbOKOnly + 32, "注意！" Else ExeCutesql "insert into 支出 values('" & Format(DTPicker1.Value, "yyyy-mm-dd") & "','" _ & Combo1.Text & "','" & txt_money.Text & "','"

36、 & Combo2.Text & "','" & txt_intake.Text _ & "','" & Combo3.Text & "','" & txt_mome.Text & "','" & B & "')", Str_text MsgBox "数据已经保存！", vbOKOnly + 64, "成功"

37、; Call Xiangmu 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.T

38、ext & "", Str_text Call Db Set Mydb = ExeCutesql("select * 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 ExeCutesq

39、l "Update 支出 Set 日期 = '" & Format(DTPicker1.Value, "yyyy-mm-dd") & "',方式='" & Combo1.Text & "',金额=" & txt_money.Text & ", 去向='" & txt_intake.Text & "',人员='" & Combo3.Text &

40、 "',备注='" & 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_Chang

41、e() Call Db2End SubPrivate Sub Form_Load() Call 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

42、 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 IEnd FunctionPublic Function Db2()

43、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 FunctionPrivate Sub

44、 Form_Unload(Cancel As Integer) 'Mydb.Close 'Mydb1.Close 'Mydb2.CloseEnd SubPrivate 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.TextMa

45、trix(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.Tex

46、tMatrix(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, &

47、quot;注意！" txt_money.SetFocus End If End IfEnd SubPrivate 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

48、 Not Str_text = Db.Fields(0) Then ExeCutesql "insert into 支出项目 values('" & Str_text & "')", "" End IfEnd FunctionPrivate Function Renyuan() 'Dim A 'Dim Str_text As String 'Dim Db As New ADODB.Recordset 'Str_text = Combo3.Text 'Set Db

49、= ExeCutesql("select * from 成员 where value='" & Str_text & "'", "") 'MsgBox 'If Not Str_text = Db.Fields(0) Then ' ExeCutesql "insert into 成员 values('" & Str_text & "')", "" 'End IfEnd Functio

50、n6、frm_family.frmDim Mydb As New ADODB.RecordsetDim Mydb1 As New ADODB.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(4)

51、 + 1 A = MsgBox("是否添加前记录?", vbYesNo + 32, "修改记录") If A = vbYes Then ExeCutesql "insert into 成员 values('" & Text1.Text & "','" & Text2.Text & "','" & Format(DTPicker1.Value, "yyyy-mm-dd") & "&

52、#39;,'" & Text3.Text & "'," & B & ") ", Str_text Call Db Mydb.MoveLast MsgBox "数据已经保存！", vbOKOnly + 64, "成功" End IfEnd SubPrivate Sub cmd_close_Click() Unload MeEnd SubPrivate Sub cmd_del_Click() On Error Resume Next Dim A A = MsgB

53、ox("是否删除当前记录", 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 IfEnd SubPrivate Sub cmd_edit