Private Sub cl_Click()
If Not (Month(Date) = 12 And Day(Date) = 31) Then
   Dim n As Integer
   n = MsgBox("未到12月31日,如提前作年終處理,則使統計數據不準和這以后的數據當年度查不到!(除非在元旦前不輸數據)" + Chr(13) + "你的確要作此處理嗎?", 36, "年終處理")
   If n = 7 Then Exit Sub
End If

Comzt_Click '整年處理
Dim i As Integer, j As Integer, SZ As Single
Dim zb As Database
Dim reyear As Recordset
Dim reyzj As Recordset
Set zb = OpenDatabase(App.Path + "\zb.mdb")
Set reyear = zb.OpenRecordset("year", dbOpenDynaset) 'dbOpenDynaset類型才能用find
reyear.FindFirst ("年度='" + myyear + "'") '在YEAR表中找當前年度的處理情況
If reyear.NoMatch = True Then '若沒有當前年度的記錄則加入
reyear.AddNew
reyear.Fields(0) = myyear
reyear.Update
reyear.FindFirst ("年度='" + myyear + "'")
End If
Data2.Recordset.MoveLast
Data2.Recordset.MoveFirst 'YZJ表移到頭
reyear.Edit
If reyear.AbsolutePosition = 0 Then '如果是年度中的第一個記錄
   reyear.Fields(1) = Data2.Recordset.Fields(1) '則用月表中的第一條記錄的上月結余
Else                                            '若是其它年度記錄則用上年度的結余
   reyear.MovePrevious
   SZ = reyear.Fields(4)
   reyear.MoveNext
   reyear.Edit
   reyear.Fields(1) = SZ
End If
For i = 5 To reyear.Fields.Count - 1
    SZ = 0
    For j = 1 To Data2.Recordset.RecordCount
      SZ = Data2.Recordset.Fields(i) + SZ '循環計算YZJ表中各項收支數值和并存入YEAR表中
      Data2.Recordset.MoveNext
    Next j
    reyear.Fields(i) = SZ
    Data2.Recordset.MoveFirst
Next i
Data2.Recordset.MoveLast
reyear.Fields(2) = 0
reyear.Fields(3) = 0
For i = 1 To 5
reyear.Fields(2) = reyear.Fields(i + 4) + reyear.Fields(2) '當年的收入
reyear.Fields(3) = reyear.Fields(i + 9) + reyear.Fields(3) '當年的支出
Next i
reyear.Fields(4) = reyear.Fields(1) + reyear.Fields(2) - reyear.Fields(3) '得到當年結余
SZ = reyear.Fields(4)
reyear.Update
reyear.FindFirst ("年度 ='" + Trim(Str(Val(myyear) + 1)) + "'") '當年處理完后,找下一年度的記錄
If reyear.NoMatch = True Then
reyear.AddNew '沒有則加入
Else
reyear.Edit
End If
reyear.Fields(0) = Trim(Str(Val(myyear) + 1)) '并且對year表中下一年度初始化
reyear.Fields(1) = SZ
reyear.Update
Set reyzj = zb.OpenRecordset("yzj", dbOpenDynaset) '打開含有每年收支數據的YZJ表(dbOpenDynaset類型才能用find)
reyzj.FindFirst ("year(年月)='" + Trim(Str(Val(myyear) + 1)) + "'") '查找下一年度的第一條記錄
If reyzj.NoMatch = True Then
reyzj.AddNew '沒找到則加入
reyzj.Fields(0) = CDate(Trim(Str(Val(myyear) + 1)) + "-1-1") '時間定為一月
Else
reyzj.Edit '有則修改
End If
reyzj.Fields(1) = SZ 'YZJ表中的上月結余修改
reyzj.Update

Set reyzj = zb.OpenRecordset("xb", dbOpenDynaset) '打開含有每天收支數據的XB表(dbOpenDynaset類型才能用find)
reyzj.FindFirst ("year(收支日期)='" + Trim(Str(Val(myyear) + 1)) + "'") '查找下一年度的第一條記錄
If reyzj.NoMatch = True Then
reyzj.AddNew '沒找到則加入
reyzj.Fields(0) = CDate(Trim(Str(Val(myyear) + 1)) + "-1-1") '時間定為一月
reyzj.Fields(1) = 0
reyzj.Fields(2) = "其它收入"
reyzj.Fields(3) = "這條記錄是程序自己加的,若本年中沒有其它收支記錄,請不要刪除它,但可以修改."
reyzj.Fields(4) = False
reyzj.Update '加入一個0收入的記錄使程序下次啟動時不會測到最新年度記錄數為0
End If
reyzj.Close
reyear.FindFirst ("年度 ='" + myyear + "'") '回到剛處理的年度
MsgBox myyear + "年度情況：" + Chr(13) + "去年結余：" + Str(reyear.Fields(1)) + Chr(13) _
+ "當年收入：" + Str(reyear.Fields(2)) + Chr(13) + "當年支出：" + Str(reyear.Fields(3)) + Chr(13) _
+ "當年結余：" + Str(reyear.Fields(4)) + Chr(13), 48, myyear + "年度處理完畢"

End Sub

Private Sub Comauto_Click()
Frmadd.Show 1
Data2.Refresh
End Sub

Private Sub Combo1_LostFocus()
Select Case Combo1.Text
 Case "工資收入"
 Case "獎金收入"
 Case "福利收入"
 Case "打工收入"
 Case "其它收入"
 Case "生活支出"
 Case "娛樂支出"
 Case "學習支出"
 Case "投資支出"
 Case "其它支出"
 Case Else
 MsgBox "您輸入的收支類別不合程序要求，這可能會造成計算及查詢的不正確！" + Chr(13) + "請點擊右邊的下拉箭頭，并從中選擇一個類別！", 48, "類別錯誤"
 Combo1.SelStart = 0
 Combo1.SelLength = Len(Combo1.Text)
 Combo1.SetFocus
 End Select
 
End Sub

Private Sub Comcancl_Click()
On Error Resume Next

Data1.Recordset.CancelUpdate


Dim t As Boolean
t = True
visok (t)
Call mok
End Sub

Private Sub comedit_Click()

Dim t As Boolean
t = False
visok (t)
Data1.Recordset.Edit
End Sub

Private Sub comlr_Click()
Frmlr.Show 1
End Sub




Private Sub comtable_Click()
Frmpic.Show 1
End Sub

Private Sub Comok_Click()
On Error Resume Next
Data1.Recordset.Update
Dim t As Boolean
t = True
visok (t)
Call mok
End Sub

Private Sub Comzt_Click()
Dim sl(4) As Single, zc(4) As Single 'sl(收入數組)zc(支出數組)
Dim zsl As Single, zzc As Single '總收入\支出
Data1.Refresh '記錄刷新(重新排序)
Data1.Recordset.MoveLast
Data1.Recordset.MoveFirst
Dim i As Integer, j As Integer
Dim qmdate As Date, qmju As Single '前面日期和結余
For j = 1 To 12
    For i = 0 To 4
    sl(i) = 0
    zc(i) = 0
    Next i
    zsl = 0
    zzc = 0
    Data1.Recordset.FindFirst "month(收支日期)=" + Str(j) '查找i月份
        If Month(Data1.Recordset.Fields(0)) <> j Then '如沒有
        GoTo last
    End If
Do While Data1.Recordset.AbsolutePosition <> -1 '是否到尾(不是最后一個記錄)
        If Month(Data1.Recordset.Fields(0)) = j Then
          Select Case Data1.Recordset.Fields(2) '分類計算
                 Case "工資收入"
                sl(0) = Data1.Recordset.Fields(1) + sl(0)
                 Case "獎金收入"
                sl(1) = Data1.Recordset.Fields(1) + sl(1)
                 Case "福利收入"
                sl(2) = Data1.Recordset.Fields(1) + sl(2)
                 Case "打工收入"
                sl(3) = Data1.Recordset.Fields(1) + sl(3)
                 Case "其它收入"
                sl(4) = Data1.Recordset.Fields(1) + sl(4)
                 Case "生活支出"
                zc(0) = Data1.Recordset.Fields(1) + zc(0)
                 Case "娛樂支出"
                zc(1) = Data1.Recordset.Fields(1) + zc(1)
                 Case "學習支出"
                zc(2) = Data1.Recordset.Fields(1) + zc(2)
                 Case "投資支出"
                zc(3) = Data1.Recordset.Fields(1) + zc(3)
                 Case "其它支出"
                zc(4) = Data1.Recordset.Fields(1) + zc(4)
          End Select
           Data1.Recordset.MoveNext '測試下一個記錄是否合適條件
        Else
           Exit Do
        End If
 Loop
 Data1.Refresh

For i = 0 To 4
zsl = zsl + sl(i) '總收入
zzc = zzc + zc(i) '總支出
Next i
    Data2.Recordset.FindFirst "month(年月)=" + Str(j) '查找統計表中的j月記錄
    
If Month(Data2.Recordset.Fields(0)) <> j Then '沒有
          Data2.Recordset.FindFirst "month(年月)=" + Str(j - 1) '查找統計表中的上一月記錄
          qmdate = Data2.Recordset.Fields(0)
          qmju = Data2.Recordset.Fields(4)
          Data2.Recordset.AddNew
          Data2.Recordset.Fields(0) = qmdate + 32
   '       Data2.Recordset.Fields(0) = CDate(Str(year(CDate(qmdate))) + "-" + Trim(Str(HScroll1.Value)) + "-1")
          Data2.Recordset.Fields(1) = qmju
          Data2.Recordset.Update
End If
   Data2.Recordset.FindFirst "month(年月)=" + Str(j - 1) '查找統計表中的上一月記錄
   If Data2.Recordset.NoMatch Then '本月就是第一條，找不到上月的
     qmju = Data2.Recordset.Fields(1)
   Else
     qmju = Data2.Recordset.Fields(4)
   End If
   Data2.Recordset.FindFirst "month(年月)=" + Str(j) '查找統計表中的當月記錄
   Data2.Recordset.Edit
   Data2.Recordset.Fields(1) = qmju
   Data2.Recordset.Fields(2) = zsl
   Data2.Recordset.Fields(3) = zzc
   Data2.Recordset.Fields(4) = Data2.Recordset.Fields(1) + zsl - zzc
For i = 0 To 4
Data2.Recordset.Fields(i + 5) = sl(i)
Data2.Recordset.Fields(i + 10) = zc(i)
Next i
Data2.Recordset.Update
last:
Next j
visok (True)
mok

End Sub

Private Sub CX_Click()
comlr_Click
End Sub

Private Sub Data1_Error(DataErr As Integer, Response As Integer)
  '這就是放置錯誤處理代碼的地方
  '如果想忽略錯誤，注釋掉下面的行
  '如果想捕捉錯誤，在這里添加錯誤處理代碼
  MsgBox "數據錯誤事件捕捉到錯誤：" & Error$(DataErr)
  Response = 0  '忽略錯誤
End Sub



Private Sub Command1_Click()

Data1.Recordset.AddNew
Data1.Recordset(2) = "工資收入"
Data1.Recordset.Update
Data1.Recordset.MoveLast
Dim t As Boolean
t = False
visok (t)
Data1.Recordset.Edit
Slirecon.max = Data1.Recordset.RecordCount - 1
Slirecon.LargeChange = Int(Slirecon.max / 10) + 1
Label9.Caption = Data1.Recordset.RecordCount
End Sub

Private Sub Command2_Click()
On Error Resume Next
If Data1.Recordset.RecordCount = 1 Then
Dim zb As Database
Dim reyear As Recordset
Dim i As Integer, n As Integer
'Data1.Recordset.Delete
MsgBox "你刪除本年最后一條收支情況，程序將關閉!", 48, "下次再來吧!"
Set zb = OpenDatabase(App.Path + "\zb.mdb")
Set reyear = zb.OpenRecordset("year", dbOpenDynaset)
n = reyear.RecordCount
For i = 1 To n + 1
    reyear.Delete
    reyear.MoveFirst
Next i
Set reyear = zb.OpenRecordset("yzj", dbOpenDynaset)
n = reyear.RecordCount
For i = 1 To n + 1
    reyear.Delete
    reyear.MoveFirst
Next i
Set reyear = zb.OpenRecordset("autoadd", dbOpenDynaset)
n = reyear.RecordCount
For i = 1 To n + 1
    reyear.Delete
    reyear.MoveFirst
Next i
Set reyear = zb.OpenRecordset("xb", dbOpenDynaset)
n = reyear.RecordCount
For i = 1 To n + 1
    reyear.Delete
    reyear.MoveFirst
Next i

Form_Unload (0)
Exit Sub
End If
        Dim ko As Integer, strsj As String, book As Variant
        strsj = Data1.Recordset.Fields(0) & " " & Str(Data1.Recordset.Fields(1)) & "元" & Data1.Recordset.Fields(3) & "的情況嗎?"
        ko = MsgBox("的確要刪除" + strsj, 36, "刪除記錄")
        If ko = vbYes Then
      
          ko = Data1.Recordset.AbsolutePosition
                   
             Data1.Recordset.Delete '每作一次刪除，AbsolutePosition =-1,當前無記錄
                Data1.Refresh '記錄刷新(重新排序)
                Data1.Recordset.MoveFirst
                Data1.Recordset.MoveLast
                Data1.Recordset.MoveFirst
                    If ko < Data1.Recordset.RecordCount - 1 Then
                Data1.Recordset.Move ko
                    Else
                Data1.Recordset.Move ko - 1
                    End If
              
        End If
 Call mok

Slirecon.max = Data1.Recordset.RecordCount - 1
Slirecon.LargeChange = Int(Slirecon.max / 10) + 1
Label9.Caption = Data1.Recordset.RecordCount
End Sub

Private Sub Command3_Click()
'Command4.Enabled = True '上移按鈕有效
Toolbar1.Buttons.Item(3).Enabled = True
sy.Enabled = True
Data1.Recordset.MoveNext '下移
If Data1.Recordset.AbsolutePosition = Data1.Recordset.RecordCount - 1 Or Data1.Recordset.AbsolutePosition = -1 Then '是否到最后一個記錄(不是檢測記錄末)
'Command3.Enabled = False '如是則下移按鈕失效
Toolbar1.Buttons.Item(4).Enabled = False
XY.Enabled = False
End If
textfind.Text = Format(Data1.Recordset.Fields(0), "yyyy-mm-dd")
Slirecon.Value = Data1.Recordset.AbsolutePosition
Label10.Caption = Str(Data1.Recordset.AbsolutePosition + 1)
End Sub

Private Sub Command4_Click()
'Command3.Enabled = True
Toolbar1.Buttons.Item(4).Enabled = True
XY.Enabled = True
Data1.Recordset.MovePrevious
If Data1.Recordset.AbsolutePosition = 0 Or Data1.Recordset.AbsolutePosition = -1 Then '是否到第一個記錄(不是檢測記錄頭)
'Command4.Enabled = False
Toolbar1.Buttons.Item(3).Enabled = False
sy.Enabled = False
End If
textfind.Text = Format(Data1.Recordset.Fields(0), "yyyy-mm-dd")
Slirecon.Value = Data1.Recordset.AbsolutePosition
Label10.Caption = Str(Data1.Recordset.AbsolutePosition + 1)
End Sub




Private Sub Command5_Click()
Data1.Refresh '記錄刷新(重新排序)
Data1.Recordset.MoveFirst
Data1.Recordset.MoveLast
Data1.Recordset.MoveFirst
mok
Slirecon.max = Data1.Recordset.RecordCount - 1
Slirecon.LargeChange = Int(Slirecon.max / 10) + 1
End Sub





'Private Sub Data2_Reposition()
''HScroll1.Value = Month(Data2.Recordset.Fields(0))
'Command6.Caption = "計算" & Trim(Str(HScroll1.Value)) & "月份"
'End Sub

Private Sub EX_Click()
comtable_Click
End Sub

Private Sub EXIT_Click()
Unload frmxb
End Sub

Private Sub Form_Activate()
Me.Caption = "小小收支薄-每日收支詳情登記" + "(" + myyear + "年度)"
Data1.RecordSource = "select * from xb where year(收支日期)='" + myyear + "' order by 收支日期"
Data1.Refresh
Data2.RecordSource = "select * from yzj where year(年月)='" + myyear + "' order by 年月"
Data2.Refresh
Data1.Recordset.MoveFirst
'Data2.Recordset.MoveFirst
visok (True)
mok

End Sub

Private Sub Form_Load()
Dim i As Integer
Combo1.AddItem "工資收入"
Combo1.AddItem "獎金收入"
Combo1.AddItem "福利收入"
Combo1.AddItem "打工收入"
Combo1.AddItem "其它收入"
Combo1.AddItem "生活支出"
Combo1.AddItem "學習支出"
Combo1.AddItem "娛樂支出"
Combo1.AddItem "投資支出"
Combo1.AddItem "其它支出"

Dim zbauto As Database
'Dim zb As Database
Dim rexb As Recordset
Dim reauto As Recordset
Dim autodate As Date