前言： 上一篇讲了如何制作结帐单报表模板，今天来说一下VB机房的账单查询，日结账单是查询一天的账单，周结账单是查询一天或几天的账单，所以周结账单也包括了日结账单的功能。 在窗体上添加GRDisplayViewer控件，接收报表。
重要代码： 在“刷新”按钮里计算充值卡余额，充值，消费，退卡金额并跟新到结帐单的数据表里。
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 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 Report.DetailGrid.Recordset.QuerySQL = "select * from checkWeek_Info where date between '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' " '通过SELECT查询创建记录集 Report.ParameterByName("begindate").Value = Format$(DTPicker1.Value, "yyyy-mm-dd") Report.ParameterByName("enddate").Value = Format$(DTPicker2.Value, "yyyy-mm-dd") GRDisplayViewer1.Refresh '刷新定义报表对象
'定义报表对象 Dim Report As grproLibCtl.GridppReport在窗体加载事件交互报表模板
Set Report = New grproLibCtl.GridppReport '实例化模版 Report.LoadFromFile (App.Path & "\机房收入周汇总表.grf") '加载模版 Report.DetailGrid.Recordset.ConnectionString = ConnectString() '连接数据源 Report.DetailGrid.Recordset.QuerySQL = "select * from checkWeek_Info " '通过SELECT查询创建记录集 Report.ParameterByName("begindate").Value = Format$(DTPicker1.Value, "yyyy-mm-dd") Report.ParameterByName("enddate").Value = Format$(DTPicker2.Value, "yyyy-mm-dd") Report.ParameterByName("XX").Value = UserName GRDisplayViewer1.Report = Report GRDisplayViewer1.Start '开始打印