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

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

———————————————————————————————— 作者：
———————————————————————————————— 日期：

50

个人收集整理 勿做商业用途
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。Ro