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

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。

V alue ＆"'）", 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 收入V ALUES（'”& 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。