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

家庭财务管理系统课程设计的原代码 作者： 日期：50 个人收集整理 勿做商业用途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.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_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 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 = 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 & ， 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 = FalseEnd SubPrivate 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 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 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 ”这已经是第一条记录了！”, 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 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 = 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 = 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 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 = ” 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 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 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 into 借入 values(” txt_man。Text & ”， & txt_money.Text , & Combo1。Text ”, Format(DTPicker1.Value， yyyy-mmdd”) & ， 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 = FalseEnd SubPrivate 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 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 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 + 32, ”注意” 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 DTPicker1.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 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 Function3、frm_choose.frmPrivate 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 SubPrivate Sub cmd_ok_Click（） On Error 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 请选择年份！”， 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， yyyymm”) 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。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 = ” Then MsgBox 请填写去向！, vbOKOnly + 32, ”注意！” Else ExeCutesql ”insert into 支出 values（” & Format(DTPicker1。Value, ”yyyy-mmdd”) ”,” _ & 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 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(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 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 SubPrivate Sub Combo2_Change() Call Db1End SubPrivate Sub Combo3_Change（） 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 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（) 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 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。Ro