frmcountquery.frm

一套简易的MIS系统。带SQLServer数据库。供参考。

            strInfo = "未结算"
        Case 1
            strInfo = "已结算"
    End Select
    getGJSState = strInfo & "[" & iInfo & "]"
    
End Function

'将初始状态锁定
Private Sub getListLock()

    chkCust.Value = 0
    cmbCust.Enabled = False
    
    chkIn.Value = 0
    cboLiuxiang.Enabled = False
    cboBuytype.Enabled = False
    
    chkOpr.Value = 0
    cmbOPr.Enabled = False
    
    chkLT.Value = 0
    cmbLT.Enabled = False
    
    chkState.Value = 0
    cmbState.Enabled = False
    
    chkGoods.Value = 0
    cmbGoods.Enabled = False
    
    chkPay.Value = 0
    optCash.Value = False
    optCash.Enabled = False
    optZZ.Value = False
    optZZ.Enabled = False
    optHK.Value = False
    optHK.Enabled = False

End Sub


'生成查询条件
Private Function getSQLString() As String
    Dim strSQL     As String
    Dim strInfo    As String
    strSQL = ""
    Select Case SSTab1.Tab
        Case 0
            strSQL = "Select A.*,B.Cust_Name From tbCcTicket A Left Join tbccCust B On(A.Cust_ID=B.Cust_ID) " _
                    & " Where Convert(varchar(10),A.Ticket_date,120) Between '" & Format(bDate.Value, "yyyy-mm-dd") & "' " _
                    & " And '" & Format(eDate.Value, "yyyy-mm-dd") & "'"
            If chkCust.Value = 1 Then
                If InStr(cmbCust.Text, "[") <> 0 Then
                    strSQL = strSQL & " And A.Cust_ID='" & tString(cmbCust.Text, "[", "]", 0) & "' "
                Else
                    strSQL = strSQL & " And A.Cust_ID Like '%%' "
                End If
            End If
            If chkLT.Value = 1 Then
                strSQL = strSQL & " And A.Ticket_state=" & tString(cmbLT.Text, "[", "]", 0) & " "
            End If
            If chkState.Value = 1 Then
                strSQL = strSQL & " And A.Instate =" & tString(cmbState.Text, "[", "]", 0) & " "
            End If
            If chkOpr.Value = 1 Then
                If InStr(cmbOPr.Text, "[") <> 0 Then
                    strSQL = strSQL & " And A.Oper_id='" & tString(cmbOPr.Text, "[", "]", 1) & "' "
                Else
                    strSQL = strSQL & " And A.Oper_id Like '%%' "
                End If
            End If
            If chkGoods.Value = 1 Then
                If InStr(cmbGoods.Text, "[") <> 0 Then
                    strSQL = strSQL & " And A.Goods_id='" & tString(cmbGoods.Text, "[", "]", 1) & "' "
                Else
                    strSQL = strSQL & " And A.Goods_id Like '%%' "
                End If
            End If
            
            If chkIn.Value = 1 Then
                strSQL = strSQL & " And A.Shop_way='" & cboBuytype.Text & "' "
            End If
            
            If chkPay.Value = 1 Then
                If optCash.Value = True Then strSQL = strSQL & " And A.PaySort_id='" & optCash.Caption & "' "
                If optZZ.Value = True Then strSQL = strSQL & " And A.PaySort_id='" & optZZ.Caption & "' "
                If optHK.Value = True Then strSQL = strSQL & " And A.PaySort_id='" & optHK.Caption & "' "
            End If
            strSQL = strSQL & " Order By A.Ticket_id "
        Case 1
            strSQL = "Select A.*,B.Cust_Name From tbCcprepay A Left Join tbccCust B On(A.Cust_ID=B.Cust_ID) " _
                    & " Where Convert(varchar(10),A.Prepay_date,120) Between '" & Format(bDate.Value, "yyyy-mm-dd") & "' " _
                    & " And '" & Format(eDate.Value, "yyyy-mm-dd") & "'"
            If chkCust.Value = 1 Then
                If InStr(cmbCust.Text, "[") <> 0 Then
                    strSQL = strSQL & " And A.Cust_ID='" & tString(cmbCust.Text, "[", "]", 0) & "' "
                Else
                    strSQL = strSQL & " And A.Cust_ID Like '%%' "
                End If
            End If
            If chkLT.Value = 1 Then
                strSQL = strSQL & " And Ticket_state=" & tString(cmbLT.Text, "[", "]", 0) & " "
            End If
            If chkState.Value = 1 Then
                strSQL = strSQL & " And A.Instate =" & tString(cmbState.Text, "[", "]", 0) & " "
            End If
            If chkOpr.Value = 1 Then
                If InStr(cmbOPr.Text, "[") <> 0 Then
                    strSQL = strSQL & " And A.Oper_id='" & tString(cmbOPr.Text, "[", "]", 1) & "' "
                Else
                    strSQL = strSQL & " And A.Oper_id Like '%%' "
                End If
            End If
            If chkGoods.Value = 1 Then
                If InStr(cmbGoods.Text, "[") <> 0 Then
                    strSQL = strSQL & " And A.Goods_id='" & tString(cmbGoods.Text, "[", "]", 1) & "' "
                Else
                    strSQL = strSQL & " And A.Goods_id Like '%%' "
                End If
            End If
            
            If chkIn.Value = 1 Then
                strSQL = strSQL & " And A.Shop_way='" & cboBuytype.Text & "' "
            End If
            
            If chkPay.Value = 1 Then
                If optCash.Value = True Then strSQL = strSQL & " And A.PaySort_id='" & optCash.Caption & "' "
                If optZZ.Value = True Then strSQL = strSQL & " And A.PaySort_id='" & optZZ.Caption & "' "
                If optHK.Value = True Then strSQL = strSQL & " And A.PaySort_id='" & optHK.Caption & "' "
            End If
            strSQL = strSQL & " Order By A.Ticket_id "
        Case 2
            strSQL = "Select * From tbCcPond " _
                    & " Where Convert(varchar(10),Oper_date,120) Between '" & Format(bDate.Value, "yyyy-mm-dd") & "' " _
                    & " And '" & Format(eDate.Value, "yyyy-mm-dd") & "' Order by Ticket_id"
        Case 3
            strSQL = "Select A.*,B.Cust_Name From tbCcFoot A Left Join tbccCust B On(A.Cust_ID=B.Cust_ID) " _
                    & " Where Convert(varchar(10),A.Oper_date,120) Between '" & Format(bDate.Value, "yyyy-mm-dd") & "' " _
                    & " And '" & Format(eDate.Value, "yyyy-mm-dd") & "'"
            If chkCust.Value = 1 Then
                If InStr(cmbCust.Text, "[") <> 0 Then
                    strSQL = strSQL & " And A.Cust_ID='" & tString(cmbCust.Text, "[", "]", 0) & "' "
                Else
                    strSQL = strSQL & " And A.Cust_ID Like '%%' "
                End If
            End If
            If chkLT.Value = 1 Then
                strSQL = strSQL & " And A.Ticket_state=" & tString(cmbLT.Text, "[", "]", 0) & " "
            End If
            If chkState.Value = 1 Then
                strSQL = strSQL & " And A.Instate =" & tString(cmbState.Text, "[", "]", 0) & " "
            End If
            If chkOpr.Value = 1 Then
                If InStr(cmbOPr.Text, "[") <> 0 Then
                    strSQL = strSQL & " And A.Oper_id='" & tString(cmbOPr.Text, "[", "]", 1) & "' "
                Else
                    strSQL = strSQL & " And A.Oper_id Like '%%' "
                End If
            End If
            
            If chkPay.Value = 1 Then
                If optCash.Value = True Then strSQL = strSQL & " And A.PaySort_id='" & optCash.Caption & "' "
                If optZZ.Value = True Then strSQL = strSQL & " And A.PaySort_id='" & optZZ.Caption & "' "
                If optHK.Value = True Then strSQL = strSQL & " And A.PaySort_id='" & optHK.Caption & "' "
            End If
            strSQL = strSQL & " Order By A.Ticket_id "
    End Select
    '显示数据
    getQueryData strSQL
End Function

'显示数据
Private Function getQueryData(strInfo As String)
    
    Dim rsTemp                  As New ADODB.Recordset
    Dim iIndex                  As Long
    Dim iRedList                As Integer
    Dim iSum                    As Single
    Dim iZL                     As Single
    Dim iCount              As Long
    Set rsTemp = Nothing
    Set rsTemp = DBCN.Execute(strInfo)
    If rsTemp.EOF = False Then
        iIndex = 1
        iSum = 0
        iZL = 0
        Select Case SSTab1.Tab
            Case 0
                lstXSInfo.ListItems.Clear
                Do Until rsTemp.EOF
                    lstXSInfo.ListItems.Add iIndex, , iIndex
                    With lstXSInfo.ListItems(iIndex)
                        .SubItems(1) = getValues(rsTemp.Fields("Ticket_id"))
                        .SubItems(2) = getValues(IIf(IsNull(rsTemp.Fields("Car_id")), "", rsTemp.Fields("Car_id")))
                        .SubItems(3) = getValues(rsTemp.Fields("Cust_id"))
                        .SubItems(4) = getValues(IIf(IsNull(rsTemp.Fields("Cust_Name")), "", rsTemp.Fields("Cust_Name")))
                        .SubItems(5) = getValues(rsTemp.Fields("Goods_id"))
                        .SubItems(6) = Format(getValues(rsTemp.Fields("Ticket_price")), "0.00")
                        .SubItems(7) = Format(getValues(rsTemp.Fields("Ticket_weigh")), "0.00")
                        iZL = iZL + Format(getValues(rsTemp.Fields("Ticket_weigh")), "0.00")
                        .SubItems(8) = Format(getValues(rsTemp.Fields("Ticket_pay")), "0.00")
                        iSum = iSum + Format(getValues(rsTemp.Fields("Ticket_pay")), "0.00")
                        .SubItems(9) = getValues(rsTemp.Fields("PaySort_id"))
                        .SubItems(10) = getValues(rsTemp.Fields("Shop_way"))
                        .SubItems(11) = getValues(rsTemp.Fields("Ticket_date"))
                        .SubItems(12) = getValues(rsTemp.Fields("Oper_id"))
                        .SubItems(13) = getValues(rsTemp.Fields("Ticket_Endate"))
                        .SubItems(14) = getLTState(getValues(rsTemp.Fields("Ticket_state")))
                        .SubItems(15) = getSysState(getValues(rsTemp.Fields("Instate")))
                        Select Case rsTemp.Fields("Instate")
                            Case -1
                                For iRedList = 1 To lstXSInfo.ColumnHeaders.Count - 1
                                    .ListSubItems(iRedList).ForeColor = vbBlue
                                Next
                            Case 2
                                For iRedList = 1 To lstXSInfo.ColumnHeaders.Count - 1
                                    .ListSubItems(iRedList).ForeColor = vbRed
                                Next
                        End Select
                    End With
                    rsTemp.MoveNext
                    iIndex = iIndex + 1
                Loop
                iCount = lstXSInfo.ListItems.Count + 1
                lstXSInfo.ListItems.Add iCount, , iCount
                lstXSInfo.ListItems(iCount).SubItems(6) = "   合计："
                lstXSInfo.ListItems(iCount).SubItems(7) = Format(iZL, "0.00")
                lstXSInfo.ListItems(iCount).SubItems(8) = Format(iSum, "0.00")
            Case 1
                lstYSINfo.ListItems.Clear
                Do Until rsTemp.EOF
                    lstYSINfo.ListItems.Add iIndex, , iIndex
                    With lstYSINfo.ListItems(iIndex)
                        .SubItems(1) = getValues(rsTemp.Fields("Ticket_id"))
                        .SubItems(2) = getValues(IIf(IsNull(rsTemp.Fields("Car_id")), "", rsTemp.Fields("Car_id")))
                        .SubItems(3) = getValues(rsTemp.Fields("Cust_id"))
                        .SubItems(4) = getValues(IIf(IsNull(rsTemp.Fields("Cust_Name")), "", rsTemp.Fields("Cust_Name")))
                        .SubItems(5) = getValues(rsTemp.Fields("Goods_id"))
                        .SubItems(6) = Format(getValues(rsTemp.Fields("Modi_price")), "0.00")
                        .SubItems(7) = Format(getValues(rsTemp.Fields("Ticket_weigh")), "0.00")
                        iZL = iZL + Format(getValues(rsTemp.Fields("Ticket_weigh")), "0.00")
                        .SubItems(8) = Format(getValues(rsTemp.Fields("Modi_pay")), "0.00")
                        iSum = iSum + Format(getValues(rsTemp.Fields("Modi_pay")), "0.00")
                        .SubItems(9) = getValues(rsTemp.Fields("PaySort_id"))
                        .SubItems(10) = getValues(rsTemp.Fields("Shop_way"))
                        .SubItems(11) = getValues(rsTemp.Fields("Prepay_date"))
                        .SubItems(12) = getValues(rsTemp.Fields("Oper_id"))
                        .SubItems(13) = getValues(rsTemp.Fields("Ticket_Endate"))
                        .SubItems(14) = getLTState(getValues(rsTemp.Fields("Ticket_state")))
                        .SubItems(15) = getSysState(getValues(rsTemp.Fields("Instate")))
                        Select Case rsTemp.Fields("Instate")
                            Case -1
                                For iRedList = 1 To lstYSINfo.ColumnHeaders.Count - 1
                                    .ListSubItems(iRedList).ForeColor = vbBlue
                                Next
                            Case 2
                                For iRedList = 1 To lstYSINfo.ColumnHeaders.Count - 1
                                    .ListSubItems(iRedList).ForeColor = vbRed
                                Next
                        End Select
                    End With
                    rsTemp.MoveNext
                    iIndex = iIndex + 1
                Loop
                iCount = lstYSINfo.ListItems.Count + 1
                lstYSINfo.ListItems.Add iCount, , iCount
                lstYSINfo.ListItems(iCount).SubItems(6) = "   合计："
                lstYSINfo.ListItems(iCount).SubItems(7) = Format(iZL, "0.00")
                lstYSINfo.ListItems(iCount).SubItems(8) = Format(iSum, "0.00")
            Case 2
                lstGBInfo.ListItems.Clear
                Do Until rsTemp.EOF
                    lstGBInfo.ListItems.Add iIndex, , iIndex
                    With lstGBInfo.ListItems(iIndex)
                        .SubItems(1) = getValues(rsTemp.Fields("Ticket_id"))
                        .SubItems(2) = getValues(IIf(IsNull(rsTemp.Fields("Pond_driver")), "", rsTemp.Fields("Pond_driver")))
                        .SubItems(3) = getValues(IIf(IsNull(rsTemp.Fields("Pond_Nodriver")), "", rsTemp.Fields("Pond_Nodriver")))
                        iZL = iZL + IIf(IsNull(rsTemp.Fields("Pond_Nodriver")), 0, rsTemp.Fields("Pond_Nodriver"))
                        .SubItems(4) = getValues(IIf(IsNull(rsTemp.Fields("Pond_no")), 0, rsTemp.Fields("Pond_no")))
                        .SubItems(5) = getValues(IIf(IsNull(rsTemp.Fields("Pond_yes")), "", rsTemp.Fields("Pond_yes")))
                        iSum = iSum + IIf(IsNull(rsTemp.Fields("Pond_yes")), 0, rsTemp.Fields("Pond_yes"))
                        .SubItems(6) = getGBState(getValues(rsTemp.Fields("Alarm_state")))
                        .SubItems(7) = getValues(IIf(IsNull(rsTemp.Fields("Car_photo")), "", rsTemp.Fields("Car_photo")))
                        .SubItems(8) = getValues(IIf(IsNull(rsTemp.Fields("Pond_photo")), "", rsTemp.Fields("Pond_photo")))
                        .SubItems(9) = getValues(rsTemp.Fields("Oper_date"))
                        .SubItems(10) = getValues(rsTemp.Fields("Car_id"))
                        .SubItems(11) = getValues(rsTemp.Fields("Oper_id"))
                        .SubItems(12) = getLTState(getValues(rsTemp.Fields("Pond_state")))
                        .SubItems(13) = getSysState(getValues(rsTemp.Fields("Instate")))
                        Select Case rsTemp.Fields("Instate")
                            Case -1
                                For iRedList = 1 To lstGBInfo.ColumnHeaders.Count - 1
                                    .ListSubItems(iRedList).ForeColor = vbBlue
                                Next
                            Case 2
                                For iRedList = 1 To lstGBInfo.ColumnHeaders.Count - 1
                                    .ListSubItems(iRedList).ForeColor = vbRed
                                Next
                        End Select
                    End With
                    rsTemp.MoveNext
                    iIndex = iIndex + 1
                Loop
                iCount = lstGBInfo.ListItems.Count + 1
                lstGBInfo.ListItems.Add iCount, , iCount
                lstGBInfo.ListItems(iCount).SubItems(2) = "   合计："
                lstGBInfo.ListItems(iCount).SubItems(3) = Format(iZL, "0.00")
                lstGBInfo.ListItems(iCount).SubItems(5) = Format(iSum, "0.00")
            Case 3
                Dim iKC, iCZ, iSZ, iQT1, iQT2, iQT3 As Single
                lstJSInfo.ListItems.Clear
                Do Until rsTemp.EOF
                    lstJSInfo.ListItems.Add iIndex, , iIndex
                    With lstJSInfo.ListItems(iIndex)
                        .SubItems(1) = getValues(rsTemp.Fields("Ticket_id"))
                        .SubItems(2) = getValues(rsTemp.Fields("Cust_id"))
                        .SubItems(3) = getValues(rsTemp.Fields("Cust_Name"))
                        .SubItems(4) = Format(getValues(IIf(IsNull(rsTemp.Fields("Pond_Nodriver")), "", rsTemp.Fields("Pond_Nodriver"))), "0.00")
                        iKC = iKC + IIf(IsNull(rsTemp.Fields("Pond_Nodriver")), 0, rsTemp.Fields("Pond_Nodriver"))
                        
                        .SubItems(5) = Format(getValues(IIf(IsNull(rsTemp.Fields("Pond_weigh")), "", rsTemp.Fields("Pond_weigh"))), "0.00")
                        iCZ = iCZ + IIf(IsNull(rsTemp.Fields("Pond_weigh")), 0, rsTemp.Fields("Pond_weigh"))
                        
                        .SubItems(6) = Format(getValues(IIf(IsNull(rsTemp.Fields("Foot_weigh")), "", rsTemp.Fields("Foot_weigh"))), "0.00")
                        iSZ = iSZ + IIf(IsNull(rsTemp.Fields("Foot_weigh")), 0, rsTemp.Fields("Foot_weigh"))
                        
                        .SubItems(7) = Format(getValues(rsTemp.Fields("Ticket_price")), "0.00")
                        
                        .SubItems(8) = Format(getValues(rsTemp.Fields("Foot_a")), "0.00")
                        iQT1 = iQT1 + IIf(IsNull(rsTemp.Fields("Foot_a")), 0, rsTemp.Fields("Foot_a"))
                        
                        .SubItems(9) = Format(getValues(rsTemp.Fields("Foot_B")), "0.00")
                        iQT2 = iQT2 + IIf(IsNull(rsTemp.Fields("Foot_B")), 0, rsTemp.Fields("Foot_B"))
                        
                        .SubItems(10) = Format(getValues(IIf(IsNull(rsTemp.Fields("Foot_C")), 0, rsTemp.Fields("Foot_C"))), "0.00")
                        iQT3 = iQT3 + IIf(IsNull(rsTemp.Fields("Foot_C")), 0, rsTemp.Fields("Foot_C"))
                        
                        .SubItems(11) = Format(getValues(IIf(IsNull(rsTemp.Fields("Foot_sum")), "", rsTemp.Fields("Foot_sum"))), "0.00")
                        iZL = iZL + IIf(IsNull(rsTemp.Fields("Foot_sum")), 0, rsTemp.Fields("Foot_sum"))
                        
                        .SubItems(12) = Format(getValues(rsTemp.Fields("Pay_sum")), "0.00")
                        iSum = iSum + IIf(IsNull(rsTemp.Fields("Pay_sum")), 0, rsTemp.Fields("Pay_sum"))
                        
                        .SubItems(13) = getValues(rsTemp.Fields("PaySort_id"))
                        .SubItems(14) = getValues(rsTemp.Fields("Oper_date"))
                        .SubItems(15) = getValues(rsTemp.Fields("Oper_id"))
                        .SubItems(16) = getGJSState(getValues(rsTemp.Fields("Ticket_state")))
                        .SubItems(17) = getSysState(getValues(rsTemp.Fields("Instate")))
                        Select Case rsTemp.Fields("Instate")
                            Case -1
                                For iRedList = 1 To lstJSInfo.ColumnHeaders.Count - 1
                                    .ListSubItems(iRedList).ForeColor = vbBlue
                                Next
                            Case 2
                                For iRedList = 1 To lstJSInfo.ColumnHeaders.Count - 1
                                    .ListSubItems(iRedList).ForeColor = vbRed
                                Next
                        End Select
                    End With
                    rsTemp.MoveNext
                    iIndex = iIndex + 1
                Loop
                iCount = lstJSInfo.ListItems.Count + 1
                lstJSInfo.ListItems.Add iCount, , iCount
                lstJSInfo.ListItems(iCount).SubItems(3) = "   合计："
                lstJSInfo.ListItems(iCount).SubItems(4) = Format(iKC, "0.00")
                lstJSInfo.ListItems(iCount).SubItems(5) = Format(iCZ, "0.00")
                lstJSInfo.ListItems(iCount).SubItems(6) = Format(iSZ, "0.00")
                lstJSInfo.ListItems(iCount).SubItems(8) = Format(iQT1, "0.00")
                lstJSInfo.ListItems(iCount).SubItems(9) = Format(iQT2, "0.00")
                lstJSInfo.ListItems(iCount).SubItems(10) = Format(iQT3, "0.00")
                lstJSInfo.ListItems(iCount).SubItems(11) = Format(iZL, "0.00")
                lstJSInfo.ListItems(iCount).SubItems(12) = Format(iSum, "0.00")
        End Select
    Else
        MsgBox "没有找到符合条件的数据！", vbInformation, "提示："
    End If
End Function

'整合数据
Private Function getValues(strInfo As String) As String
    
    getValues = IIf(IsNull(strInfo), "", strInfo)
    
End Function