form7.frm

Visual Basic开发的 家庭收支管理系统后台数据库Acce

        xl.Worksheets(1).Rows(1).Font.Size = 15
        '调整列宽
        xl.Worksheets(1).Columns(1).columnwidth = 6
        xl.Worksheets(1).Columns(2).columnwidth = 11
        xl.Worksheets(1).Columns(3).columnwidth = 11
        xl.Worksheets(1).Columns(4).columnwidth = 11
        xl.Worksheets(1).Columns(5).columnwidth = 11
        xl.Worksheets(1).Columns(6).columnwidth = 11
        xl.Worksheets(1).Columns(7).columnwidth = 11
        xl.Worksheets(1).Columns(8).columnwidth = 11
        xl.Worksheets(1).Columns(9).columnwidth = 11

'表头各类型
For xl1 = 1 To 10
    xl.Worksheets(1).cells(2, xl1 + 1).Value = zlx(xl1) '第二行为收支类型
    xl.Worksheets(1).Rows(2).Font.ColorIndex = 7 '字体为粉红色
Next xl1

'选择循环次数
If chek = 0 Then
   mo = 12
Else
    mo = 31
End If

ProgressBar1.Visible = True
ProgressBar1.Min = 1
ProgressBar1.Max = mo
'输出每月或日各类型金额
For pr = 1 To mo
    For pr1 = 1 To 10
        If chek = 0 Then
           xl.Worksheets(1).cells(pr + 2, pr1).Value = tj(pr, pr1)
        Else
           xl.Worksheets(1).cells(pr + 2, pr1).Value = tj1(pr, pr1)
        End If
     If ProgressBar1.Value < mo - 1 Then ProgressBar1.Value = pr + (1 / 10) * pr1
    Next pr1
    ProgressBar1.Value = pr
Next pr




'输出各类型金额
For lxhe1 = 2 To 10
    lxhe(lxhe1) = 0
    For lxhe2 = 1 To mo
        If chek = 0 Then
          lxhe(lxhe1) = lxhe(lxhe1) + tj(lxhe2, lxhe1)
        Else
          lxhe(lxhe1) = lxhe(lxhe1) + tj1(lxhe2, lxhe1)
        End If
    Next lxhe2
    xl.Worksheets(1).cells(pr + 2, lxhe1).Value = lxhe(lxhe1)
Next lxhe1
    xl.Worksheets(1).cells(pr + 2, 1).Value = "总计"
    xl.Worksheets(1).Rows(pr + 2).Font.ColorIndex = 5 '字体为红色
    
    
    
    
'财政状况总结
xl.Worksheets(1).cells(pr + 3, 1).Value = MSChart1.FootnoteText
xl.Worksheets(1).Rows(pr + 3).WrapText = True '自动换行
xl.Worksheets(1).Rows(pr + 3).Font.ColorIndex = 3 '字体为红色
Dim hb As String
Dim ll As Integer
Dim hh As Integer
hh = pr + 3
ll = pr + 4
hb = "A" & hh & ":" & "G" & ll
xl.Worksheets(1).Range(hb).mergecells = True
 
 ' 保存工作表
xl.Worksheets(1).SaveAs path
'从内存中删除Excel对象
xl.Application.Quit
 ' 清除
Set xl = Nothing
MsgBox "成功导出！导出文件为：" & path
   ProgressBar1.Visible = False  '隐藏进度
   ProgressBar1.Value = 1
End Sub

Private Sub Command2_Click()

If Adodc1.Recordset.BOF Then
MsgBox "数据库中无收支记录，无法统计！"
Exit Sub
End If

sftj = 1 '第一次统计后变量值改变
ProgressBar1.Visible = True  '显示进度

If Check2.Value = 0 Then
chek = 0 '最后一次统计状态
ProgressBar1.Value = 1
ProgressBar1.Min = 1 '进度条最小值
ProgressBar1.Max = 12 '进度条最大值
If Option1.Value = True Then '如果为支出统计
'获取支出类型
Adodc2.RecordSource = "select * from zclx"
cap = Left(Option1.Caption, 1)
sz = Left(Option1.Caption, 2)
Else
'获取收入类型
Adodc2.RecordSource = "select * from sylx"
cap = Left(Option2.Caption, 1)
sz = Left(Option2.Caption, 2)
End If

Adodc2.Refresh

'清空以前的类型
i = 1
For i = 1 To 10
    zlx(i) = ""
Next i

i = 1
Adodc2.Recordset.MoveFirst
While Not Adodc2.Recordset.EOF
       zlx(i) = Adodc2.Recordset.Fields(0)
       i = i + 1
       Adodc2.Recordset.MoveNext
Wend

'设置数据源
Adodc1.RecordSource = "select * from szb"
Adodc1.Refresh


 For iii = 1 To 12

   For ii = 1 To 10 '为计算每种类型最多循环9次
   
     dd(ii) = 0 '清空金额
       Adodc1.Recordset.MoveFirst '移到记录前
       While Not Adodc1.Recordset.EOF '记录不为空
             
             If Str(Year(Adodc1.Recordset.Fields(0))) = Str(Left(Combo1.Text, 4)) And _
                Month(Adodc1.Recordset.Fields(0)) = iii And _
                Adodc1.Recordset.Fields(1) = cap And _
                Adodc1.Recordset.Fields(3) = zlx(ii) Then '确定年份,收或支，收支类型
                dd(ii) = dd(ii) + Adodc1.Recordset.Fields(2) '计算一类型总金额
             End If
                Adodc1.Recordset.MoveNext '移到下一条记录
        Wend

       tj(iii, 1) = Str(iii) & "月"
       If ii < 10 Then '防止收入类型下标越界
       tj(iii, ii + 1) = dd(ii)
       Else
       tj(iii, ii) = dd(ii)
       End If
       
        MSChart1.ChartData = tj
   Next ii
   ProgressBar1.Value = iii '进度值
 Next iii
 
        '设定标签
        For ii = 1 To 10
        If zlx(ii) <> "" Then
        MSChart1.Column = ii
        MSChart1.ColumnLabel = zlx(ii)
        Else
        If ii < 10 Then
        MSChart1.Column = ii
        MSChart1.ColumnLabel = "无"
        End If
        End If
        Next ii
MSChart1.Title = Combo1.Text & "每月各类型" & sz & "年统计报表"


Else
chek = 1 '最后一次统计状态
ProgressBar1.Value = 1 '
ProgressBar1.Min = 1 '进度条最小值
ProgressBar1.Max = 31 '进度条最大值
If Option1.Value = True Then '如果为支出统计
'获取支出类型
Adodc2.RecordSource = "select * from zclx"
cap = Left(Option1.Caption, 1)
Else
'获取收入类型
Adodc2.RecordSource = "select * from sylx"
cap = Left(Option2.Caption, 1)
End If

Adodc2.Refresh

'清空以前的类型
i = 1
For i = 1 To 10
    zlx(i) = ""
Next i

i = 1
Adodc2.Recordset.MoveFirst
While Not Adodc2.Recordset.EOF
       zlx(i) = Adodc2.Recordset.Fields(0)
       i = i + 1
       Adodc2.Recordset.MoveNext
Wend

'设置数据源
Adodc1.RecordSource = "select * from szb"
Adodc1.Refresh

 For iii = 1 To 31
   For ii = 1 To 10 '为计算每种类型最多循环10次
   
     dd(ii) = 0 '清空金额
     
       Adodc1.Recordset.MoveFirst '移到记录前
       
       While Not Adodc1.Recordset.EOF '记录不为空
                '测定月份为一位还是两位数
                If Len(Combo2.Text) = 2 Then
                mon = Str(Left(Combo2.Text, 1))
                Else
                mon = Str(Left(Combo2.Text, 2))
                End If
                
             If Str(Year(Adodc1.Recordset.Fields(0))) = Str(Left(Combo1.Text, 4)) And _
                Str(Month(Adodc1.Recordset.Fields(0))) = mon And _
                Str(Day(Adodc1.Recordset.Fields(0))) = iii And _
                Adodc1.Recordset.Fields(1) = cap And _
                Adodc1.Recordset.Fields(3) = zlx(ii) Then '确定年份,月份，收或支，收支类型
                dd(ii) = dd(ii) + Adodc1.Recordset.Fields(2) '计算一类型总金额
             End If
                Adodc1.Recordset.MoveNext '移到下一条记录
        Wend
        
       tj1(iii, 1) = Str(iii)
       If ii < 10 Then '防止收入类型下标越界
       tj1(iii, ii + 1) = dd(ii)
       Else
       tj1(iii, ii) = dd(ii)
       End If
    
       MSChart1.ChartData = tj1
         
   Next ii
   ProgressBar1.Value = iii '进度值
 Next iii
        '设定标签
        For ii = 1 To 10
        If zlx(ii) <> "" Then
        MSChart1.Column = ii
        MSChart1.ColumnLabel = zlx(ii)
        Else
        If ii < 10 Then
        MSChart1.Column = ii
        MSChart1.ColumnLabel = "无"
        End If
        End If
        Next ii
MSChart1.Title = Combo1.Text & Combo2.Text & "每日各类型" & sz & "月统计报表"

End If

   ProgressBar1.Visible = False  '隐藏进度
   ProgressBar1.Value = 1

End Sub

Private Sub Command3_Click()
Unload Me
End Sub

Private Sub Form_Load()
'加载当前年的前五年和后五年
Dim ii As Integer
For ii = Year(Date) - 10 To Year(Date)
    Combo1.AddItem ii & "年"
Next ii
Combo1.Text = Year(Date) & "年"

'加载月份
Dim iii As Integer
For iii = 1 To 12
    Combo2.AddItem iii & "月"
Next iii
Combo2.Text = Month(Date) & "月"
'*****************************************************************************************
'初始化图表
Dim arrValues(1 To 12, 1 To 10)
Dim i As Integer
For i = 1 To 12
   arrValues(i, 1) = Str(i)
   arrValues(i, 2) = 0
   arrValues(i, 3) = 0
   arrValues(i, 4) = 0
   arrValues(i, 5) = 0
   arrValues(i, 6) = 0
   arrValues(i, 7) = 0
   arrValues(i, 8) = 0
   arrValues(i, 9) = 0
   arrValues(i, 10) = 0
Next i
MSChart1.ChartData = arrValues
MSChart1.Column = 1
MSChart1.ColumnLabel = "代表收支类型"
MSChart1.Column = 2
MSChart1.ColumnLabel = "代表收支类型"
MSChart1.Column = 3
MSChart1.ColumnLabel = "代表收支类型"
MSChart1.Column = 4
MSChart1.ColumnLabel = "代表收支类型"
MSChart1.Column = 5
MSChart1.ColumnLabel = "代表收支类型"
MSChart1.Column = 6
MSChart1.ColumnLabel = "代表收支类型"
MSChart1.Column = 7
MSChart1.ColumnLabel = "代表收支类型"
MSChart1.Column = 8
MSChart1.ColumnLabel = "代表收支类型"
MSChart1.Column = 9
MSChart1.ColumnLabel = "代表收支类型"

'******************************************************************
Adodc1.ConnectionString = ado
Adodc2.ConnectionString = ado
Adodc1.RecordSource = "select * from szb"
Adodc1.Refresh
'******************************************************************  统计财政状况
Adodc3.ConnectionString = ado
Adodc3.RecordSource = "select * from csh"
Adodc3.Refresh
Adodc4.ConnectionString = ado
Adodc4.RecordSource = "select * from zjld "
Adodc4.Refresh

'计算各月收与支
Dim gysy, gyzc As Currency
gysy = 0
gyzc = 0
If Not Adodc1.Recordset.BOF Then
   While Not Adodc1.Recordset.EOF
         If Adodc1.Recordset.Fields(1) = "收" Then
            gysy = gysy + Adodc1.Recordset.Fields(2)
         Else
            gyzc = gyzc + Adodc1.Recordset.Fields(2)
         End If
            Adodc1.Recordset.MoveNext
   Wend
End If

'计算各月借入借出存入取出
Dim gyjr, gyjc, gyck As Currency
gyjr = 0
gyjc = 0
gyck = 0
If Not Adodc4.Recordset.BOF Then
   While Not Adodc4.Recordset.EOF
         Select Case Adodc4.Recordset.Fields(1)
                Case "取钱"
                     gyck = gyck - Adodc4.Recordset.Fields(2)
                Case "存钱"
                     gyck = gyck + Adodc4.Recordset.Fields(2)
                Case "别人还钱"
                     gyjc = gyjc - Adodc4.Recordset.Fields(2)
                Case "别人借钱"
                     gyjc = gyjc + Adodc4.Recordset.Fields(2)
                Case "借别人钱"
                     gyjr = gyjr + Adodc4.Recordset.Fields(2)
                Case "还别人钱"
                     gyjr = gyjr - Adodc4.Recordset.Fields(2)
         End Select
    Adodc4.Recordset.MoveNext
    Wend
End If

'保存初始借入，借出，存款，活动金
Dim csjr, csjc, csck, cshdj As Currency
csjr = 0
csjc = 0
csck = 0
cshdj = 0
If Not Adodc3.Recordset.BOF Then
csck = Adodc3.Recordset.Fields(5)
cshdj = Adodc3.Recordset.Fields(6)
csjc = Adodc3.Recordset.Fields(7)
csjr = Adodc3.Recordset.Fields(8)
End If

'计算活动资金、总资金、总借入，总借出，总存款
Dim hdj, zzj, zjr, zjc, zck As Currency
hdj = 0
zzj = 0
zjr = 0
zjc = 0
zck = 0
hdj = cshdj + gysy - gyzc - gyck - gyjc + gyjr
zzj = csck + cshdj + csjc + gysy - gyzc - csjr
zjr = csjr + gyjr
zjc = csjc + gyjc
zck = csck + gyck
bjje = zzj
MSChart1.FootnoteText = "您的总资金：" & zzj & "元；总支出：" & gyzc & "元；总收入：" & gysy & "元；活动资金：" & hdj & "元；存款" & zck & "元；借出：" & zjc & "元；借入：" & zjr & "元。"
End Sub