frm_report.frm

ktv场所的包房开房、迎宾、预定管理系统。

        txt_ids(0).Enabled = False
        txt_ids(1).Enabled = False
    End If
    If Me.comb_lx.ListIndex = 3 Then
        txt_ids(0).Enabled = True
        txt_ids(1).Enabled = True
        txt_ids(0).SetFocus
    End If
    If Me.comb_lx.ListIndex = 0 Then
        TxtSQL = "select * from counterid where TableName='printsn'"
        Set mrc = ExecuteSQL(TxtSQL, msgtext)
        txt_ids(0) = 1
        TxtSQL = "select * from counterid where TableName='sale_id'"
        Set mrc = ExecuteSQL(TxtSQL, msgtext)
        txt_ids(1) = mrc.Fields("CountNum")
        txt_ids(1).Enabled = False
        txt_ids(0).Enabled = False
    End If
End Sub

Private Sub Command1_Click(Index As Integer)
   Dim TxtSQL As String
   Dim msgtext As String
   Dim mrc As ADODB.Recordset
    Dim roomnum As Integer
    Dim roomstr As String
    Dim BTarray(9) As Integer
    Dim recBT(9) As String
    Dim txt As New clsText
    Dim rpt As New report
    Dim recBT1(8) As String
    Select Case Index
        Case 0
            Select Case Me.comb_lx.ListIndex
                Case 0, 1, 3
                    TxtSQL = "select account_id,discrition,sum(account) as finalprice"
                    TxtSQL = TxtSQL & " from sale_bank "
                    TxtSQL = TxtSQL & " where sale_id>=" & Val(Me.txt_ids(0))
                    TxtSQL = TxtSQL & " and sale_id<=" & Val(Me.txt_ids(1))
                    TxtSQL = TxtSQL & " group by discrition,account_id"
                    TxtSQL = TxtSQL & " order by account_id"
                    Set mrc = ExecuteSQL(TxtSQL, msgtext)
                    Set Me.msglist2.DataSource = mrc
                    showtitle12
                    
                    TxtSQL = "select  b.p_id,b.product_name,b.unit,avg(b.price) as price,sum(b.qty) as qty,sum(b.finalprice) as finalprice"
                    TxtSQL = TxtSQL & " from sale_head as a,sale as b"
                    TxtSQL = TxtSQL & " where a.sale_id=b.sale_id"
                    TxtSQL = TxtSQL & " and a.sale_id>=" & Val(Me.txt_ids(0))
                    TxtSQL = TxtSQL & " and a.sale_id<=" & Val(Me.txt_ids(1))
                    TxtSQL = TxtSQL & " group by p_id,product_name,unit"
                    TxtSQL = TxtSQL & " order by p_id"
                Case 2
                    TxtSQL = "select account_id,discrition,sum(account) as finalprice"
                    TxtSQL = TxtSQL & " from sale_bank "
                    TxtSQL = TxtSQL & " where account_time>=#" & Me.dtptime(0).Value & "#"
                    TxtSQL = TxtSQL & " and account_time<=#" & Me.dtptime(1).Value & "#"
                    TxtSQL = TxtSQL & " group by discrition,account_id"
                    TxtSQL = TxtSQL & " order by account_id"
                    Set mrc = ExecuteSQL(TxtSQL, msgtext)
                    Set Me.msglist2.DataSource = mrc
                    showtitle12
                
                    TxtSQL = "select  b.p_id,b.product_name,b.unit,avg(b.price) as price,sum(b.qty) as qty,sum(b.finalprice) as finalprice"
                    TxtSQL = TxtSQL & " from sale_head as a,sale as b"
                    TxtSQL = TxtSQL & " where a.sale_id=b.sale_id"
                    TxtSQL = TxtSQL & " and a.sale_date>=#" & Me.dtptime(0).Value & "#"
                    TxtSQL = TxtSQL & " and a.sale_date<=#" & Me.dtptime(1).Value & "#"
                    TxtSQL = TxtSQL & " group by p_id,product_name,unit"
                    TxtSQL = TxtSQL & " order by p_id"
            End Select
            Set mrc = ExecuteSQL(TxtSQL, msgtext)
            Set Me.msglist.DataSource = mrc
            showtitle
        Case 1
            rpt.SetPrinter 11905.488, 7370.064, Portrait
            '定义页首
            Set txt = New clsText
            With txt
                .stringX = struserinfoname & Space(40)
                .fontsize = 14
                .FontName = "黑体"
                .FontBold = True
                .FontUnderLine = True
                .Align = tyLeft
            End With
            rpt.Title.AddText "title1", txt
            Set txt = Nothing
                        
            Set txt = New clsText
            With txt
                .stringX = "|第&p页/共&s页"
                .fontsize = 10
            End With
            rpt.Title.AddText "title2", txt
            Set txt = Nothing
            
            '定义表首
            Set txt = New clsText
            With txt
                .stringX = "销售报表(" & aaa & ")"
                .fontsize = 13
                .FontBold = True
                .Align = tymiddle
            End With
            rpt.Header.AddText "head1", txt
            Set txt = Nothing
            
            Set txt = New clsText
            With txt
                .stringX = "帐单号从:" & Me.txt_ids(0) & "到" & Me.txt_ids(1)
                .fontsize = 10
                .Align = tyLeft
            End With
            rpt.Header.AddText "head2", txt
            Set txt = Nothing
            
            Set txt = New clsText
            With txt
                .stringX = "操作员:" & strCurUser & "|" & "打印日期:" & dteSysDate
                .fontsize = 10
                .Align = tyLeft
            End With
            rpt.Header.AddText "head3", txt
            Set txt = Nothing
            
            rpt.LeftSection.AlignMode = tyContent
            rpt.RightSection.AlignMode = tyContent
            rpt.Align = tymiddle
            report = False
            rpt.AttachFlexGrid msglist
            'rpt.AttachFlexGrid MSHFlexGrid1
            'rpt.ReadTemplate Left(App.Path, Len(App.Path)) & "\dllprint\rptkc.txt"
            rpt.Preview
    
        Case 2
            rpt.SetPrinter 11905.488, 7370.064, Portrait
            '定义页首
            Set txt = New clsText
            With txt
                .stringX = struserinfoname & Space(22)
                .fontsize = 14
                .FontName = "黑体"
                .FontBold = True
                .FontUnderLine = True
                .Align = tyLeft
            End With
            rpt.Title.AddText "title1", txt
            Set txt = Nothing
                                               
            Set txt = New clsText
            With txt
                .stringX = "|第&p页/共&s页"
                .fontsize = 10
            End With
            rpt.Title.AddText "title2", txt
            Set txt = Nothing
            
            '定义表首
            Set txt = New clsText
            With txt
                .stringX = "销售报表(收款汇总)"
                .fontsize = 13
                .FontBold = True
                .Align = tymiddle
            End With
            rpt.Header.AddText "head1", txt
            Set txt = Nothing
            
            Set txt = New clsText
            With txt
                .stringX = "帐单号从:" & Me.txt_ids(0) & "到" & Me.txt_ids(1)
                .fontsize = 10
                .Align = tyLeft
            End With
            rpt.Header.AddText "head2", txt
            Set txt = Nothing
            
            Set txt = New clsText
            With txt
                .stringX = "操作员:" & strCurUser & "|" & "打印日期:" & dteSysDate
                .fontsize = 10
                .Align = tyLeft
            End With
            rpt.Header.AddText "head3", txt
            Set txt = Nothing
                        
            rpt.LeftSection.AlignMode = tyContent
            rpt.RightSection.AlignMode = tyContent
            rpt.Align = tymiddle
            BTarray(1) = 1000
            BTarray(2) = 3000
            BTarray(3) = 1800
            recBT(1) = "产品编号"
            recBT(2) = "产品名称"
            recBT(3) = "单位"
            rpt.AttachFlexGrid msglist2
            rpt.Preview
        
        Case 3
            Unload Me
    End Select
End Sub

Private Sub Form_Load()
    Dim TxtSQL As String
    Dim msgtext As String
    Dim mrc As ADODB.Recordset
   
    comb_lx.AddItem "当班报表"
    comb_lx.AddItem "前班报表"
    comb_lx.AddItem "时间段报表"
    comb_lx.AddItem "帐单号报表"
    Me.dtptime(0).Value = dteSysDate
    Me.dtptime(1).Value = dteSysDate
    TxtSQL = "select * from counterid where TableName='printsn'"
    Set mrc = ExecuteSQL(TxtSQL, msgtext)
    txt_ids(0) = 1
    TxtSQL = "select * from counterid where TableName='sale_id'"
    Set mrc = ExecuteSQL(TxtSQL, msgtext)
    txt_ids(1) = mrc.Fields("CountNum")
    txt_ids(1).Enabled = False
    txt_ids(0).Enabled = False
    Me.comb_lx.ListIndex = 0
    Command1_Click (0)
End Sub

Private Sub msglist_Click()
    Dim TxtSQL As String
    Dim msgtext As String
    Dim mrc As ADODB.Recordset
    
    If msglist.row > 0 Then
        Select Case Me.comb_lx.ListIndex
            Case 0, 1, 3
                TxtSQL = "select  a.sale_id,b.p_id,b.product_name,b.unit,b.price,b.qty,b.finalprice,b.maker,b.room_number,b.account_time"
                TxtSQL = TxtSQL & " from sale_head as a,sale as b"
                TxtSQL = TxtSQL & " where a.sale_id=b.sale_id"
                TxtSQL = TxtSQL & " and a.sale_id>=" & Val(Me.txt_ids(0))
                TxtSQL = TxtSQL & " and a.sale_id<=" & Val(Me.txt_ids(1))
                TxtSQL = TxtSQL & " and p_id='" & Me.msglist.TextMatrix(msglist.row, 0) & "'"
                TxtSQL = TxtSQL & " order by a.sale_id"
            Case 2
                TxtSQL = "select  a.sale_id,b.p_id,b.product_name,b.unit,b.price,b.qty,b.finalprice,b.maker,b.room_number,b.account_time"
                TxtSQL = TxtSQL & " from sale_head as a,sale as b"
                TxtSQL = TxtSQL & " where a.sale_id=b.sale_id"
                TxtSQL = TxtSQL & " and a.sale_date>=#" & Me.dtptime(0).Value & "#"
                TxtSQL = TxtSQL & " and a.sale_date<=#" & Me.dtptime(1).Value & "#"
                TxtSQL = TxtSQL & " and p_id='" & Me.msglist.TextMatrix(msglist.row, 0) & "'"
                TxtSQL = TxtSQL & " order by p_id"
        End Select
        Set mrc = ExecuteSQL(TxtSQL, msgtext)
        Set Me.msglist1.DataSource = mrc
        showtitle1
    End If
End Sub
Private Sub showtitle()
    Dim i As Integer
    
    With msglist
        .Cols = 6
          If .rows <= 2 Then
            .rows = 2
        End If
        .TextMatrix(0, 0) = "编号"
        .TextMatrix(0, 1) = "项目名称"
        .TextMatrix(0, 2) = "单位"
        .TextMatrix(0, 3) = "单价"
        .TextMatrix(0, 4) = "数量"
        .TextMatrix(0, 5) = "金额"
        '设置各列的对齐方
        For i = 1 To 5
            .ColAlignment(i) = 1
        Next i
        '表头项居中
        .FillStyle = flexFillRepeat
        .col = 0
        .row = 0
        '.RowSel = 1
        .ColSel = .Cols - 1
        '.CellAlignment = 4
        '设置单元大小
        .colWidth(0) = 1200
        .colWidth(1) = 2500
        .colWidth(2) = 1000
        .colWidth(3) = 800
        .colWidth(4) = 800
        .colWidth(5) = 1000
        '.Row = 1
    End With
End Sub
Private Sub showtitle1()
    Dim i As Integer
    
    With msglist1
        .Cols = 10
      If .rows <= 2 Then
            .rows = 2
        End If
        .TextMatrix(0, 0) = "帐号"
        .TextMatrix(0, 1) = "编号"
        .TextMatrix(0, 2) = "项目名称"
        .TextMatrix(0, 3) = "单位"
        .TextMatrix(0, 4) = "单价"
        .TextMatrix(0, 5) = "数量"
        .TextMatrix(0, 6) = "金额"
        .TextMatrix(0, 7) = "制单人"
        .TextMatrix(0, 8) = "台号"
        .TextMatrix(0, 9) = "销售时间"
        '设置各列的对齐方
        For i = 1 To 9
            .ColAlignment(i) = 1
        Next i
        '表头项居中
        .FillStyle = flexFillRepeat
        .col = 0
        .row = 0
        '.RowSel = 1
        .ColSel = .Cols - 1
        '.CellAlignment = 4
        '设置单元大小
        .colWidth(0) = 800
        .colWidth(1) = 1000
        .colWidth(2) = 2000
        .colWidth(3) = 800
        .colWidth(4) = 800
        .colWidth(5) = 800
        .colWidth(6) = 800
        .colWidth(7) = 1100
        .colWidth(8) = 800
        .colWidth(9) = 1200
        '.Row = 1
    End With
End Sub
Private Sub showtitle12()
    Dim i As Integer
    
    With msglist2
        .Cols = 3
        '.Rows = 2
        
        .TextMatrix(0, 1) = "项目名称"
        .TextMatrix(0, 2) = "金额"
        .TextMatrix(0, 0) = "编号"
        '设置各列的对齐方
        For i = 1 To 2
            .ColAlignment(i) = 1
        Next i
        '表头项居中
        .FillStyle = flexFillRepeat
        .col = 0
        .row = 0
        '.RowSel = 1
        .ColSel = .Cols - 1
        '.CellAlignment = 4
        '设置单元大小
        .colWidth(0) = 1200
        .colWidth(1) = 2500
        .colWidth(2) = 2000
        '.Row = 1
    End With
End Sub

Private Sub msglist2_Click()
    Dim TxtSQL As String
    Dim msgtext As String
    Dim mrc As ADODB.Recordset
    
    TxtSQL = "select a.p_id,a.product_name,a.unit,avg(a.price) as pricee,sum(a.qty) as qtyy,sum(a.finalprice) as finalpricee from sale as a,sale_head as b,sale_bank as c"
    TxtSQL = TxtSQL & " where a.sale_id=b.sale_id"
    TxtSQL = TxtSQL & " and a.sale_id=c.sale_id"
    TxtSQL = TxtSQL & " and c.account_id='" & Me.msglist2.TextMatrix(Me.msglist2.row, 0) & "'"
    TxtSQL = TxtSQL & " and b.sale_id>=" & Val(Me.txt_ids(0))
    TxtSQL = TxtSQL & " and b.sale_id<=" & Val(Me.txt_ids(1))
    TxtSQL = TxtSQL & " group by a.p_id,a.product_name,a.unit"
    TxtSQL = TxtSQL & " order by a.p_id"
    Set mrc = ExecuteSQL(TxtSQL, msgtext)
    Set Me.msglist1.DataSource = mrc
    showtitle111
    If Me.msglist1.row > 0 Then
        aaa = Me.msglist1.TextMatrix(Me.msglist1.row, 0)
    End If
End Sub
Private Sub showtitle111()
    Dim i As Integer
    
    With msglist1
        .Cols = 6
          If .rows <= 2 Then
            .rows = 2
        End If
        .TextMatrix(0, 0) = "编号"
        .TextMatrix(0, 1) = "项目名称"
        .TextMatrix(0, 2) = "单位"
        .TextMatrix(0, 3) = "单价"
        .TextMatrix(0, 4) = "数量"
        .TextMatrix(0, 5) = "金额"
        '设置各列的对齐方
        For i = 1 To 5
            .ColAlignment(i) = 1
        Next i
        '表头项居中
        .FillStyle = flexFillRepeat
        .col = 0
        .row = 0
        '.RowSel = 1
        .ColSel = .Cols - 1
        '.CellAlignment = 4
        '设置单元大小
        .colWidth(0) = 1200
        .colWidth(1) = 2500
        .colWidth(2) = 1000
        .colWidth(3) = 800
        .colWidth(4) = 800
        .colWidth(5) = 1000
        '.Row = 1
    End With
End Sub