上篇部落格說了報表怎麼做，但是日、周結賬單製作報表還是不行的，還要把賬算清楚，機房的難點就是把賬算對了，不能虧錢，我的思路就是充退卡、充值、下機表中獲取總金額，然後相互加減，下面看一下我的程式碼吧。

日結賬單

Dim txtsql As String
    Dim strMsg As String
    Dim mrc As ADODB.Recordset
    Dim mrcc As ADODB.Recordset
    Dim mrccc As ADODB.Recordset
    Dim mrcccc As ADODB.Recordset
    Dim mrccccc As
 
 ADODB.Recordset
    Dim SYE As Currency
    Dim XF As Currency
    Dim CZ As Currency
    Dim TK As Currency
    Dim YE As Currency

    txtsql = "select sum(allcash) from checkday_info where date = '" & Date - 1 & "'"     '計算上期餘額
    Set mrc = ExecuteSQL(txtsql, strMsg)

    If IsNull(mrc.Fields(0
 
)) = True Then
        SYE = 0
    Else
        SYE = Trim(mrc.Fields(0))
    End If

    txtsql = "select sum(addmoney) from ReCharge_Info where date='" & Date & "'"           '計算充值金額
    Set mrcc = ExecuteSQL(txtsql, strMsg)

    If IsNull(mrcc.Fields(0)) = True Then
        CZ = 0
    Else
        CZ = Trim(mrcc.Fields(0
 
))
    End If

    txtsql = "select sum(cancelcash) from cancelcard_Info where date='" & Date & "'"        '計算退卡金額
    Set mrccc = ExecuteSQL(txtsql, strMsg)

    If IsNull(mrccc.Fields(0)) = True Then
        TK = 0
    Else
        TK = Trim(mrccc.Fields(0))
    End If

    txtsql = "select sum(consume) from line_Info where ondate='" & Date & "'"        '計算消費金額
    Set mrcccc = ExecuteSQL(txtsql, strMsg)

    If IsNull(mrcccc.Fields(0)) = True Then
        XF = 0
    Else
        XF = Trim(mrcccc.Fields(0))
    End If

    YE = SYE - CZ - TK                                           '今日餘額

    txtsql = "select * from CheckDay_info "
    Set mrccccc = ExecuteSQL(txtsql, strMsg)

    mrc.AddNew
    mrccccc.Fields(0) = Trim(SYE)
    mrccccc.Fields(1) = Trim(CZ)
    mrccccc.Fields(2) = Trim(XF)
    mrccccc.Fields(3) = Trim(TK)
    mrccccc.Fields(4) = Trim(YE)
    mrccccc.Fields(5) = Trim(Date)
    mrccccc.Update

    txtsql = "select * from CheckDay_Info where date = '" & Format(Date, "yyyy-mm-dd") & "'"
    Set Report = New grproLibCtl.GridppReport

    Report.LoadFromFile (App.Path & "\1.grf")   '載入模版
    Report.DetailGrid.Recordset.ConnectionString = ConnectString()    '資料來源
    Report.DetailGrid.Recordset.QuerySQL = txtsql

    Report.ParameterByName("guanli").AsString = UserName '通過SELECT查詢建立記錄集

    Report.ParameterByName("guanli").Value = UserName  '通過SELECT查詢建立記錄集

    GRDisplayViewer1.Report = Report
    GRDisplayViewer1.Start

周結賬單和日結賬單差不多，只是周結賬單時選擇兩個日期段之間金額計算

    Dim txtsql As String
    Dim msgtext As String
    Dim mrc As ADODB.Recordset
    Dim mrcc As ADODB.Recordset
    Dim mrccc As ADODB.Recordset
    Dim mrcccc As ADODB.Recordset
    Dim mrccccc As ADODB.Recordset
    Dim mrcccccc As ADODB.Recordset
    Dim CZK As Currency
    Dim SCZ As Currency
    Dim XF As Currency
    Dim TK As Currency
    Dim CZ As Currency
    Text1.Text = ""

    If DTPicker1.Value > DTPicker2.Value Then
       MsgBox "終止時間不能小於起始時間！", vbOKOnly + vbExclamation, "警告"
       Exit Sub
    End If

    '計算本期消費金額
    txtsql = "select sum(consumecash) from Checkday_Info where date between'" & Format$(DTPicker1.Value, "yyyy-mm-dd") & "'" & "and'" & Format$(DTPicker2.Value, "yyyy-mm-dd") & "'"
    Set mrc = ExecuteSQL(txtsql, msgtext)
    Debug.Print txtsql

    If IsNull(mrc.Fields(0)) = True Then
       XF = 0
    Else
       XF = Trim(mrc.Fields(0))
    End If

    '計算本期退卡金額
    txtsql = "select sum(cancelcash) from Checkday_Info where date between'" & Format$(DTPicker1.Value, "yyyy-mm-dd") & "'" & "and'" & Format$(DTPicker2.Value, "yyyy-mm-dd") & "'"
    Set mrcc = ExecuteSQL(txtsql, msgtext)
    Debug.Print txtsql

    If IsNull(mrcc.Fields(0)) = True Then
       TK = 0
    Else
       TK = Trim(mrcc.Fields(0))
    End If

    '計算本期充值卡餘額
    txtsql = "select sum(allcash) from CheckDay_Info where date between '" & Format(CDate(DTPicker1.Value)) & "' and '" & Format(CDate(DTPicker2.Value)) & "'"
    Set mrccc = ExecuteSQL(txtsql, msgtext)
    Debug.Print txtsql

    If IsNull(mrccc.Fields(0)) = True Then
       CZK = 0
    Else
       CZK = Trim(mrccc.Fields(0))
    End If

    '計算本期充值金額
    txtsql = "select sum(rechargecash) from CheckDay_Info where date between '" & Format(CDate(DTPicker1.Value)) & "' and '" & Format(CDate(DTPicker2.Value)) & "'"
    Set mrcccc = ExecuteSQL(txtsql, msgtext)
    Debug.Print txtsql

    If IsNull(mrcccc.Fields(0)) = True Then
       CZ = 0
    Else
       CZ = Trim(mrcccc.Fields(0))
    End If

    '計算上期充值卡金額
    txtsql = "select sum(allcash) from CheckDay_Info where date < '" & CDate(DTPicker1.Value) & "'"
    Set mrccccc = ExecuteSQL(txtsql, msgtext)
    Debug.Print txtsql

    If IsNull(mrccccc.Fields(0)) = True Then
       SCZ = 0
    Else
       SCZ = Trim(mrccccc.Fields(0))
    End If

    txtsql = "select * from checkWeek_Info "
    Set mrcccccc = ExecuteSQL(txtsql, msgtext)
    mrcccccc.AddNew
    mrcccccc.Fields(0) = Trim(SCZ)
    mrcccccc.Fields(1) = Trim(CZ)
    mrcccccc.Fields(2) = Trim(XF)
    mrcccccc.Fields(3) = Trim(TK)
    mrcccccc.Fields(4) = Trim(CZK)
    mrcccccc.Fields(5) = Trim(Date)
    mrcccccc.Update

    txtsql = "select * from Checkweek_Info where date between '" & Format(CDate(DTPicker1.Value)) & "' and '" & Format(CDate(DTPicker2.Value)) & "'"
    Set Report = New grproLibCtl.GridppReport

    Report.LoadFromFile (App.Path & "\2.grf")    '載入模版
    Report.DetailGrid.Recordset.ConnectionString = ConnectString()    '資料來源
    Report.DetailGrid.Recordset.QuerySQL = txtsql

    GRDisplayViewer1.Refresh

    Report.ParameterByName("start").Value = Format$(DTPicker1.Value, "yyyy-mm-dd")
    Report.ParameterByName("end").Value = Format$(DTPicker2.Value, "yyyy-mm-dd")
    GRDisplayViewer1.Refresh
    MsgBox "賬單重新整理成功！", 48, "提示"