frm_cgreport.frm

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

            If msglist.rows <= 2 Then Exit Sub
            
            Dim app As New Excel.Application
            Dim book As New Excel.Workbook
            Dim sheet As New Excel.Worksheet
            Set book = app.Workbooks.Add
            Set sheet = book.Worksheets.Add
            app.Visible = False
            pb.Visible = True
            pb.Min = 0
            pb.Max = msglist.rows - 1
            pb.Value = 0
            Dim lCol As Long, lRow As Long
            For lRow = 1 To msglist.rows - 1
                For lCol = 0 To msglist.Cols - 1
                    sheet.cells(lRow, lCol + 1) = msglist.TextMatrix(lRow, lCol)
                    
                Next
                pb.Value = pb.Value + 1
            Next
            
            pb.Value = 0
            pb.Visible = False
            app.Visible = True
                    
            Set app = Nothing
            Set book = Nothing
            Set sheet = Nothing
        



        

        Case 3
            Unload Me
    End Select
End Sub

Private Sub Form_Load()
   
    comb_lx.AddItem "日报表"
    comb_lx.AddItem "月报表"
    comb_lx.AddItem "时间段报表"
    
    comb_lxx.AddItem "采购入库报表"
    comb_lxx.AddItem "盘盈入库报表"
    comb_lxx.AddItem "其它入库报表"
    comb_lxx.AddItem "退库报表"
    comb_lxx.AddItem "报损报表"
    comb_lxx.AddItem "盘点报损报表"
    comb_lxx.AddItem "盘点报溢报表"    '"盘点报损报表"
    
    
    dtptime(0).Value = Now
    dtptime(1).Value = Now
    comb_lx.ListIndex = 0
    comb_lxx.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 comb_lx.ListIndex
            Case 0
                TxtSQL = "select  a.ps_id,b.p_id,b.p_name,b.unit,b.unit_price,b.qty,b.price,a.ps_maker,a.ps_rid,a.ps_type,a.ps_date"
                TxtSQL = TxtSQL & " from ps_head_b as a,order_detail_b as b"
                TxtSQL = TxtSQL & " where a.ps_id=b.order_id"
                TxtSQL = TxtSQL & " and a.p_flag=false "

                 Select Case comb_lxx.ListIndex
                    Case 0
                        TxtSQL = TxtSQL & " and a.ps_type='采购入库'"
                    Case 1
                        TxtSQL = TxtSQL & " and a.ps_type='盘盈入库'"
                    Case 2
                       TxtSQL = TxtSQL & " and a.ps_type='其它入库'"
                    Case 3
                        TxtSQL = TxtSQL & " and a.ps_type='退库单'"
                    Case 4
                        TxtSQL = TxtSQL & " and a.ps_type='报损单'"
                    Case 5
                        TxtSQL = TxtSQL & " and a.ps_type='仓库盘点报损'"
                    Case 6
                        TxtSQL = TxtSQL & " and a.ps_type='仓库盘点报溢'"
                        
                End Select
                TxtSQL = TxtSQL & " and format(a.ps_date,'yyyy-MM')='" & Format(dtptime(0).Value, "yyyy-MM") & "'"
                TxtSQL = TxtSQL & " and p_id='" & msglist.TextMatrix(msglist.row, 0) & "'"
                TxtSQL = TxtSQL & " order by order_id"
            Case 1
                TxtSQL = "select  a.ps_id,b.p_id,b.p_name,b.unit,b.unit_price,b.qty,b.price,a.ps_maker,a.ps_rid,a.ps_type,a.ps_date"
                TxtSQL = TxtSQL & " from ps_head_b as a,order_detail_b as b"
                TxtSQL = TxtSQL & " where a.ps_id=b.order_id"
                TxtSQL = TxtSQL & " and a.p_flag=false "
                 Select Case comb_lxx.ListIndex
                    Case 0
                        TxtSQL = TxtSQL & " and a.ps_type='采购入库'"
                    Case 1
                        TxtSQL = TxtSQL & " and a.ps_type='盘盈入库'"
                    Case 2
                       TxtSQL = TxtSQL & " and a.ps_type='其它入库'"
                    Case 3
                        TxtSQL = TxtSQL & " and a.ps_type='退库单'"
                    Case 4
                        TxtSQL = TxtSQL & " and a.ps_type='报损单'"
                    Case 5
                        TxtSQL = TxtSQL & " and a.ps_type='仓库盘点报损'"
                    Case 6
                        TxtSQL = TxtSQL & " and a.ps_type='仓库盘点报溢'"
                
                End Select
                TxtSQL = TxtSQL & " and format(a.ps_date,'yyyy-MM')='" & Format(dtptime(0).Value, "yyyy-MM") & "'"
                TxtSQL = TxtSQL & " and p_id='" & msglist.TextMatrix(msglist.row, 0) & "'"
                TxtSQL = TxtSQL & " order by order_id"
            Case 2
                TxtSQL = "select  a.ps_id,b.p_id,b.p_name,b.unit,b.unit_price,b.qty,b.price,a.ps_maker,a.ps_rid,a.ps_type,a.ps_date"
                TxtSQL = TxtSQL & " from ps_head_b as a,order_detail_b as b"
                TxtSQL = TxtSQL & " where a.ps_id=b.order_id"
                TxtSQL = TxtSQL & " and a.p_flag=false "
                Select Case comb_lxx.ListIndex
                    Case 0
                        TxtSQL = TxtSQL & " and a.ps_type='采购入库'"
                    Case 1
                        TxtSQL = TxtSQL & " and a.ps_type='盘盈入库'"
                    Case 2
                       TxtSQL = TxtSQL & " and a.ps_type='其它入库'"
                    Case 3
                        TxtSQL = TxtSQL & " and a.ps_type='退库单'"
                    Case 4
                        TxtSQL = TxtSQL & " and a.ps_type='报损单'"
                    Case 5
                        TxtSQL = TxtSQL & " and a.ps_type='仓库盘点报损'"
                    Case 6
                        TxtSQL = TxtSQL & " and a.ps_type='仓库盘点报溢'"
                
                End Select
                TxtSQL = TxtSQL & " and format(a.ps_date,'yyyy-MM-dd')>='" & Format(dtptime(0).Value, "yyyy-MM-dd") & "'"
                TxtSQL = TxtSQL & " and format(a.ps_date,'yyyy-MM-dd')<='" & Format(dtptime(1).Value, "yyyy-MM-dd") & "'"
                TxtSQL = TxtSQL & " and p_id='" & msglist.TextMatrix(msglist.row, 0) & "'"
                TxtSQL = TxtSQL & " order by order_id"
            Case 3
            End Select
        Set mrc = ExecuteSQL(TxtSQL, msgtext)
        Set msglist1.DataSource = mrc
        showtitle1
        mrc.Close
        Set mrc = Nothing
    End If
End Sub
Private Sub showtitle()
    
    With msglist
        .FillStyle = flexFillRepeat
        .col = 0
        .row = 0
        .ColSel = .Cols - 1
        
        .Cols = 6
        .TextMatrix(0, 0) = "编号"
        .TextMatrix(0, 1) = "产品名称"
        .TextMatrix(0, 2) = "单位"
        .TextMatrix(0, 3) = "单价"
        .TextMatrix(0, 4) = "数量"
        .TextMatrix(0, 5) = "金额"

        .ColAlignment(1) = 1
        .ColAlignment(2) = 1
        .ColAlignment(3) = 1
        .ColAlignment(4) = 1
        .ColAlignment(5) = 1

        .colWidth(0) = 900
        .colWidth(1) = 4000
        .colWidth(2) = 800
        .colWidth(3) = 1200
        .colWidth(4) = 800
        .colWidth(5) = 1600

    End With
End Sub

Private Sub showtitle1()
    Dim i As Integer
    
    With msglist1
        .Cols = 11
        '.Rows = 2
        .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) = "单据类型"
        .TextMatrix(0, 10) = "入库日期"
        '设置各列的对齐方
        For i = 1 To 10
            .ColAlignment(i) = 1
        Next i
        '表头项居中
        .FillStyle = flexFillRepeat
        .col = 0
        .row = 0
        '.RowSel = 1
        .ColSel = .Cols - 1
        '.CellAlignment = 4
        '设置单元大小
        .colWidth(0) = 1200
        .colWidth(1) = 1000
        .colWidth(2) = 2200
        .colWidth(3) = 700
        .colWidth(4) = 700
        .colWidth(5) = 700
        .colWidth(6) = 800
        .colWidth(7) = 800
        .colWidth(8) = 800
        .colWidth(9) = 800
        .colWidth(10) = 1000
        '.Row = 1
    End With
End Sub
Private Sub txt_id_Change()
Dim i, j, m As Integer
Dim s As String
    If Trim$(txt_id.text) <> "" Then
        s = Mid(txt_id.text, 1, 1)
        If Asc(s) > 57 Or Asc(s) < 48 Then
            m = 0
            With msglist
                For i = 1 To .rows - 1
                    For j = 1 To Len(Trim$(txt_id.text))
                        If Mid(Trim$(.TextMatrix(i, 1)), j, 1) = Mid(Trim$(txt_id.text), j, 1) Then
                            If j > m Then
                                .col = 1
                                .row = i
                                .TopRow = i
                                m = j
                            End If
                        Else
                            Exit For
                        End If
                    Next j
                Next i
            End With
        Else
            m = 0
            With msglist
                For i = 1 To .rows - 1
                    For j = 1 To Len(Trim$(txt_id.text))
                        If Mid(Trim$(.TextMatrix(i, 0)), j, 1) = UCase(Mid(Trim$(txt_id.text), j, 1)) Then
                            If j > m Then
                                .col = 1
                                .row = i
                                .TopRow = i
                                m = j
                            End If
                        Else
                            Exit For
                        End If
                    Next j
                Next i
            End With
        End If
    End If

End Sub