form5.frm

本软件主要的使用对象是家庭与个人。它提供了比较完善的收支记录、查询修改、统计报表等功能。您可以自定义各种系统参数：如自定义用户名、密码、系统自动备份时间、资金不足警示、各种收支类型等。您还可以手动备份

Adodc1.Refresh
rcs = Adodc1.RecordSource '重新排序时记录其数据源
Set DataGrid1.DataSource = Adodc1
DataGrid1.Visible = True
End If

DataGrid1.Columns(0).Caption = " 收支时间"
DataGrid1.Columns(0).Width = 1000
DataGrid1.Columns.Remove (1)
DataGrid1.Columns(1).Caption = " 收支金额"
DataGrid1.Columns(1).Width = 1000
DataGrid1.Columns(2).Caption = " 收支类型"
DataGrid1.Columns(2).Width = 1000
DataGrid1.Columns(3).Caption = "      备    注"
DataGrid1.Columns(3).Width = 1800

'统计结果
he = 0
If Not Adodc1.Recordset.BOF Then
   Adodc1.Recordset.MoveFirst
   While Not Adodc1.Recordset.EOF
         he = he + Adodc1.Recordset.Fields(2)
         Adodc1.Recordset.MoveNext
   Wend
End If

If he <> 0 Then
Text4.Text = "    从" & Year(DTPicker1.Value) & "年" & Month(DTPicker1.Value) & "月" & Day(DTPicker1.Value) & "日" _
            & "至" & Year(DTPicker2.Value) & "年" & Month(DTPicker2.Value) & "月" & Day(DTPicker2.Value) & "日，" _
            & "收支金额在" & Text2.Text & "元至" & Text3.Text & "元之间的“" & Combo2.Text & "”的发生金额总共为" & he & "元！"
Else
Text4.Text = "没有查询到符合条件的记录！"
End If

Exit Sub

End If


'********************************************************************************************
If Text1.Text <> "" And Text2.Text <> "" And Text3.Text <> "" Then

If Combo2.Text = "所有类型" Then
sql = "Select * From szb Where date >=" & DTPicker1.Value - DTPicker1.MinDate + 2 & " and date <=" & DTPicker2.Value - DTPicker2.MinDate + 2 & " And sz='" & Left(Combo1.Text, 1) & "' and mn>=" & Text2.Text & " and mn<=" & Text3.Text & " and bz like '%" & Text1.Text & "%'"
Adodc1.RecordSource = sql
Adodc1.Refresh
rcs = Adodc1.RecordSource '重新排序时记录其数据源
Set DataGrid1.DataSource = Adodc1
DataGrid1.Visible = True
Else
sql = "Select * From szb Where date >=" & DTPicker1.Value - DTPicker1.MinDate + 2 & " and date <=" & DTPicker2.Value - DTPicker2.MinDate + 2 & " And sz='" & Left(Combo1.Text, 1) & "' And lx='" & Combo2.Text & "' and mn>=" & Text2.Text & " and mn<=" & Text3.Text & " and bz like '%" & Text1.Text & "%'"
Adodc1.RecordSource = sql
rcs = Adodc1.RecordSource '重新排序时记录其数据源
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
DataGrid1.Visible = True
End If

DataGrid1.Columns(0).Caption = " 收支时间"
DataGrid1.Columns(0).Width = 1000
DataGrid1.Columns.Remove (1)
DataGrid1.Columns(1).Caption = " 收支金额"
DataGrid1.Columns(1).Width = 1000
DataGrid1.Columns(2).Caption = " 收支类型"
DataGrid1.Columns(2).Width = 1000
DataGrid1.Columns(3).Caption = "      备    注"
DataGrid1.Columns(3).Width = 1800

'统计结果
he = 0
If Not Adodc1.Recordset.BOF Then
   Adodc1.Recordset.MoveFirst
   While Not Adodc1.Recordset.EOF
         he = he + Adodc1.Recordset.Fields(2)
         Adodc1.Recordset.MoveNext
   Wend
End If

If he <> 0 Then
Text4.Text = "    从" & Year(DTPicker1.Value) & "年" & Month(DTPicker1.Value) & "月" & Day(DTPicker1.Value) & "日" _
            & "至" & Year(DTPicker2.Value) & "年" & Month(DTPicker2.Value) & "月" & Day(DTPicker2.Value) & "日，" _
            & "备注中含有“" & Text1.Text & "”关键字且" & "收支金额在" & Text2.Text & "元至" & Text3.Text & "元之间的“" & Combo2.Text & "”的发生金额总共为" & he & "元！"
Else
Text4.Text = "没有查询到符合条件的记录！"
End If

Exit Sub

End If

'**********************************************************************************************

Else

If Combo2.Text = "所有类型" Then
sql = "Select * From szb Where date >=" & DTPicker1.Value - DTPicker1.MinDate + 2 & " and date <=" & DTPicker2.Value - DTPicker2.MinDate + 2 & " And sz='" & Left(Combo1.Text, 1) & "'"
Adodc1.RecordSource = sql
Adodc1.Refresh
rcs = Adodc1.RecordSource '重新排序时记录其数据源
Set DataGrid1.DataSource = Adodc1
DataGrid1.Visible = True
Else
sql = "Select * From szb Where date >=" & DTPicker1.Value - DTPicker1.MinDate + 2 & " and date <=" & DTPicker2.Value - DTPicker2.MinDate + 2 & " And sz='" & Left(Combo1.Text, 1) & "' And lx='" & Combo2.Text & "'"
Adodc1.RecordSource = sql
Adodc1.Refresh
rcs = Adodc1.RecordSource '重新排序时记录其数据源
Set DataGrid1.DataSource = Adodc1
DataGrid1.Visible = True
End If

DataGrid1.Columns(0).Caption = " 收支时间"
DataGrid1.Columns(0).Width = 1000
DataGrid1.Columns.Remove (1)
DataGrid1.Columns(1).Caption = " 收支金额"
DataGrid1.Columns(1).Width = 1000
DataGrid1.Columns(2).Caption = " 收支类型"
DataGrid1.Columns(2).Width = 1000
DataGrid1.Columns(3).Caption = "      备    注"
DataGrid1.Columns(3).Width = 1800
'统计结果
he = 0
If Not Adodc1.Recordset.BOF Then
   Adodc1.Recordset.MoveFirst
   While Not Adodc1.Recordset.EOF
         he = he + Adodc1.Recordset.Fields(2)
         Adodc1.Recordset.MoveNext
   Wend
End If

If he <> 0 Then
Text4.Text = "从" & Year(DTPicker1.Value) & "年" & Month(DTPicker1.Value) & "月" & Day(DTPicker1.Value) & "日" _
            & "至" & Year(DTPicker2.Value) & "年" & Month(DTPicker2.Value) & "月" & Day(DTPicker2.Value) & "日，" _
            & "您“" & Combo2.Text & "”的发生金额总共为" & he & "元！"
Else
Text4.Text = "没有查询到符合条件的记录！"
End If

End If

rcs = Adodc1.RecordSource '重新排序时记录其数据源
End Sub

Private Sub Command3_Click()
If DataGrid1.AllowUpdate = False Then
   DataGrid1.AllowUpdate = True
   DataGrid1.AllowDelete = True
   Command3.Caption = "锁定"
   MsgBox "您巳进入修改状态！"
   
Else
   DataGrid1.AllowUpdate = False
   DataGrid1.AllowDelete = True
   Command3.Caption = "修改"
   MsgBox "您进入锁定状态！"
   
End If

End Sub


Private Sub Command4_Click()
 '是否有记录
If Not Adodc1.Recordset.BOF Then
        '选择导出路径
        CommonDialog1.FileName = ""
        CommonDialog1.ShowSave
        If CommonDialog1.FileName = "" Then
           Exit Sub
        End If
        '保存文件路径及名字
        Dim path As String
        path = CommonDialog1.FileName
        
        Dim i As Integer           ' 循环计数器
        Dim j As Integer
        Dim xl As Object           ' OLE自动化对象

        Set xl = CreateObject("Excel.Sheet.8")
        
        '合并第一行表格
        xl.Worksheets(1).Range("A1:D1").mergecells = True
        '表头标题
        xl.Worksheets(1).cells(1, 1).Value = "               家  庭  收  支  管  理  报  表"
        xl.Worksheets(1).Rows(1).Font.ColorIndex = 5 '字体为蓝色
        xl.Worksheets(1).Rows(1).Font.Size = 15
        '调整列宽
        xl.Worksheets(1).Columns(1).columnwidth = 15
        xl.Worksheets(1).Columns(2).columnwidth = 15
        xl.Worksheets(1).Columns(3).columnwidth = 15
        xl.Worksheets(1).Columns(4).columnwidth = 32
        '将字段名添加到电子表格中
        xl.Worksheets(1).cells(3, 1).Value = Trim(DataGrid1.Columns(0).Caption)
        xl.Worksheets(1).cells(3, 2).Value = Trim(DataGrid1.Columns(1).Caption)
        xl.Worksheets(1).cells(3, 3).Value = Trim(DataGrid1.Columns(2).Caption)
        xl.Worksheets(1).cells(3, 4).Value = Trim(DataGrid1.Columns(3).Caption)
        xl.Worksheets(1).Rows(3).Font.ColorIndex = 7 '字体为粉红色
        
            i = 0
            Adodc1.Recordset.MoveFirst '移到前面，以免导出不全
            Do While Not Adodc1.Recordset.EOF
                ' 加每个字段的值加到工作表中
                For j = 0 To Adodc1.Recordset.Fields.Count - 2
                      xl.Worksheets(1).cells(i + 4, j + 1).Value = DataGrid1.Columns(j)
                Next j
                Adodc1.Recordset.MoveNext
                i = i + 1
            Loop
              
            xl.Worksheets(1).cells(i + 5, 1).Value = Text4.Text '查询统计
            xl.Worksheets(1).Rows(i + 5).WrapText = True '自动换行
            xl.Worksheets(1).Rows(i + 5).Font.ColorIndex = 3 '字体为红色
            
            Dim D1, A1 As Integer
            Dim DA As String
            D1 = i + 6
            A1 = i + 5
            DA = "A" & A1 & ":" & "D" & D1
            xl.Worksheets(1).Range(DA).mergecells = True '合并最后一行
            
            ' 保存工作表
            xl.Worksheets(1).SaveAs path
                        '从内存中删除Excel对象
            xl.Application.Quit
           ' 清除
           Set xl = Nothing
           MsgBox "成功导出！导出文件为：" & path
Else
          MsgBox "没有记录，无法导出！"
End If
End Sub


Private Sub DataGrid1_BeforeColEdit(ByVal ColIndex As Integer, ByVal KeyAscii As Integer, Cancel As Integer)
If ColIndex = 2 Then
MsgBox "您不能修改“收入类型”，否则将导致计算错误！"
Cancel = True
End If
End Sub



Private Sub DataGrid1_HeadClick(ByVal ColIndex As Integer)
Adodc1.RecordSource = rcs & " Order By " & DataGrid1.Columns(ColIndex).DataField
Adodc1.Refresh
DataGrid1.Columns(0).Caption = " 收支时间"
DataGrid1.Columns(0).Width = 1000
DataGrid1.Columns.Remove (1)
DataGrid1.Columns(1).Caption = " 收支金额"
DataGrid1.Columns(1).Width = 1000
DataGrid1.Columns(2).Caption = " 收支类型"
DataGrid1.Columns(2).Width = 1000
DataGrid1.Columns(3).Caption = "      备    注"
DataGrid1.Columns(3).Width = 1800
End Sub

Private Sub DataGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If DataGrid1.AllowUpdate And Button = 2 And Not Adodc1.Recordset.BOF And Not Adodc1.Recordset.EOF Then PopupMenu MDIForm1.pop
End Sub

Private Sub DTPicker1_CloseUp()
If DTPicker1.Value > Date Then
   MsgBox "您不能选择未来的日期！"
   DTPicker1.Value = DTPicker2.Value
Exit Sub
End If

If DTPicker1.Value > DTPicker2.Value Then
   MsgBox "您选的起始日期大于结束日期！"
    DTPicker1.Value = DTPicker2.Value
    Exit Sub
End If

End Sub


Private Sub DTPicker2_CloseUp()
If DTPicker2.Value > Date Then
   MsgBox "您不能选择未来的日期！"
   DTPicker2.Value = DTPicker1.Value
Exit Sub
End If

If DTPicker1.Value > DTPicker2.Value Then
   MsgBox "您选的结束日期小于起始日期！"
    DTPicker2.Value = DTPicker1.Value
    Exit Sub
End If
End Sub


Private Sub Form_Load()
Adodc1.ConnectionString = ado


'添加支出类型至组合框
Combo2.Clear
Adodc2.ConnectionString = ado
Adodc2.RecordSource = "zclx"
Adodc2.Refresh
While Not Adodc2.Recordset.EOF
      Combo2.AddItem Adodc2.Recordset.Fields(0)
      Adodc2.Recordset.MoveNext
Wend
Combo2.AddItem "所有类型"
Combo2.Text = Combo2.List(0)
DTPicker1.Value = Date
DTPicker2.Value = Date
End Sub