vb3a3.tmp

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

        chkGoods.Value = 0
        cmbGoods.Enabled = False
        
        chkCash.Value = 0
        
        chkCust.Value = 0
        cmbCust.Enabled = False
        chkLX.Value = 0
    End If
    
End Sub

Private Sub chkLX_Click()
    
    If chkLX.Value = 1 Then
        chkOpr.Value = 0
        cmbOprInfo.Enabled = False
        
        chkGoods.Value = 0
        cmbGoods.Enabled = False
        
        chkCash.Value = 0
        chkGB.Value = 0
        chkJS.Value = 0
        
        chkCust.Value = 0
        cmbCust.Enabled = False
    End If
    
End Sub

Private Sub chkOpr_Click()
    
    If chkOpr.Value = 1 Then
        cmbOprInfo.Enabled = True
        chkGoods.Value = 0
        cmbGoods.Enabled = False
        
        chkCash.Value = 0
        chkGB.Value = 0
        chkJS.Value = 0
        
        chkCust.Value = 0
        cmbCust.Enabled = False
        chkLX.Value = 0
    Else
        cmbOprInfo.Enabled = False
    End If
    
End Sub

Private Sub cmdClose_Click()
    
    '返回
    tBackMain Me
     
End Sub

Private Sub cmdOK_Click()
    
    On Error GoTo ErrInfo
    
    If getSQLString = False Then MsgBox "条件错误！请检查条件", vbInformation, "提示：": Exit Sub
    getHeadList iCountFlag
    
    getDataList strCountTab, iCountFlag
    
    SSTab1.Tab = 0
    
    Exit Sub
ErrInfo:
    MsgBox Err.Description, vbInformation, "提示："
    
End Sub

Private Sub Form_Load()

    '计算窗体显示位置
    tFormSpace frmMain, Me, uWindows
    
    '显示基础数据
    Call getBaseInfo
    
    bDate.Value = Format(tServerDate, "YYYY年MM月DD日")
    eDate.Value = Format(tServerDate, "YYYY年MM月DD日")
    
    Call getControlEnable
    
    '首次显示时显示列头
    getHeadList 0

End Sub

Private Sub getBaseInfo()
    
    Dim rsTemp                     As New ADODB.Recordset
    
    Set rsTemp = DBCN.Execute("Select Cust_ID,Cust_Name From tbccCust Where Instate=0 Order By Cust_ID")
    
    If rsTemp.EOF = False Then
        cmbCust.Clear
        cmbCust.AddItem "全部"
        Do Until rsTemp.EOF
            cmbCust.AddItem rsTemp.Fields("Cust_name") & "[" & rsTemp.Fields("Cust_ID") & "]"
            rsTemp.MoveNext
        Loop
        cmbCust.Text = cmbCust.List(0)
    Else
        cmbCust.Clear
        cmbCust.AddItem "全部"
        cmbCust.Text = cmbCust.List(0)
    End If
    
    Set rsTemp = DBCN.Execute("Select Oper_ID,Oper_Name From TbCCOper Where Instate=0 Order By Oper_ID")
    
    If rsTemp.EOF = False Then
        cmbOprInfo.Clear
        cmbOprInfo.AddItem "全部"
        Do Until rsTemp.EOF
            cmbOprInfo.AddItem rsTemp.Fields("Oper_Name") & "[" & rsTemp.Fields("Oper_ID") & "]"
            rsTemp.MoveNext
        Loop
        cmbOprInfo.Text = cmbOprInfo.List(0)
    Else
        cmbOprInfo.Clear
        cmbOprInfo.AddItem "全部"
        cmbOprInfo.Text = cmbCust.List(0)
    End If
    
    Set rsTemp = DBCN.Execute("Select Goods_ID,Goods_Name From tbccGoods Where Instate=0 Order By Goods_ID")
    
    If rsTemp.EOF = False Then
        cmbGoods.Clear
        cmbGoods.AddItem "全部"
        Do Until rsTemp.EOF
            cmbGoods.AddItem rsTemp.Fields("Goods_Name") & "[" & rsTemp.Fields("Goods_ID") & "]"
            rsTemp.MoveNext
        Loop
        cmbGoods.Text = cmbGoods.List(0)
    Else
        cmbGoods.Clear
        cmbGoods.AddItem "全部"
        cmbGoods.Text = cmbCust.List(0)
    End If
        
End Sub

'设置控件无效
Private Sub getControlEnable()
    
    chkOpr.Value = 0
    cmbOprInfo.Enabled = False
    
    chkGoods.Value = 0
    cmbGoods.Enabled = False
    
    chkCash.Value = 0
    chkGB.Value = 0
    chkJS.Value = 0
    
    chkCust.Value = 0
    cmbCust.Enabled = False
    
    chkLX.Value = 0
    
End Sub

'依据条件
Private Function getSQLString() As Boolean
    
    Dim strSQL                      As String
    Dim isSQL                       As Boolean
    getSQLString = False
    If chkOpr.Value = 1 Then
        getSQLString = True
        iCountFlag = 0
        strCountTab = "tbcc_OprCountList"
        If InStr(cmbOprInfo.Text, "[") <> 0 Then
            strSQL = "Select Oper_ID,(Case Instate When 0 Then Sum(Ticket_Weigh) Else 0 End) as iCount, " _
                    & " (Case Instate When 0 Then Sum(Ticket_Pay) Else 0 End) as iWeight, " _
                    & " (Case Instate When 2 Then Sum(Ticket_Weigh) Else 0 End) as iCount1, " _
                    & " (Case Instate When 2 Then Sum(Ticket_Pay) Else 0 End) as iChange, " _
                    & " (Case Instate When -1 Then Sum(Ticket_Weigh) Else 0 End) as iCount2, " _
                    & " (Case Instate When -1 Then Sum(Ticket_Pay) Else 0 End) AS iCash " _
                    & " Into tbcc_OprCount From tbCcTicket Where Convert(Varchar(10),Ticket_Date,120) Between '" & Format(bDate.Value, "yyyy-mm-dd") & "' And " _
                    & " '" & Format(eDate.Value, "yyyy-mm-dd") & "' And Oper_ID Like '" & tString(cmbOprInfo.Text, "[", "]", 1) & "%' " _
                    & " Group By Oper_ID,Instate Order By Oper_ID"
        Else
            strSQL = "Select Oper_ID,(Case Instate When 0 Then Sum(Ticket_Weigh) Else 0 End) as iCount, " _
                    & " (Case Instate When 0 Then Sum(Ticket_Pay) Else 0 End) as iWeight, " _
                    & " (Case Instate When 2 Then Sum(Ticket_Weigh) Else 0 End) as iCount1, " _
                    & " (Case Instate When 2 Then Sum(Ticket_Pay) Else 0 End) as iChange, " _
                    & " (Case Instate When -1 Then Sum(Ticket_Weigh) Else 0 End) as iCount2, " _
                    & " (Case Instate When -1 Then Sum(Ticket_Pay) Else 0 End) AS iCash " _
                    & " Into tbcc_OprCount From tbCcTicket Where Convert(Varchar(10),Ticket_Date,120) Between '" & Format(bDate.Value, "yyyy-mm-dd") & "' And " _
                    & " '" & Format(eDate.Value, "yyyy-mm-dd") & "' And Oper_ID Like '%%' " _
                    & " Group By Oper_ID,Instate Order By Oper_ID"
        End If
        '建立临时表
        DBCN.Execute "If Exists(Select * from sysObjects Where Name ='tbcc_OprCount') Drop Table tbcc_OprCount"
        DBCN.Execute strSQL
        
        '整理数据
        DBCN.Execute "If Exists(Select * from sysObjects Where Name ='tbcc_OprCountList') Drop Table tbcc_OprCountList"
        DBCN.Execute "Select Oper_ID,Sum(iCount) AS iCount,Sum(iWeight) as iWeight,Sum(iCount1) As iCount1, " _
                    & " Sum(iChange) As iChange,Sum(iCount2) AS iCount2,Sum(iCash) AS iCash " _
                    & " Into tbcc_OprCountList From tbcc_OprCount Group By Oper_ID Order By Oper_ID"
    End If

    
End Function

'显示信息
Private Function getHeadList(iList As Integer)
    
    Select Case iList
        Case 0
            With lstDataInfo
                .ListItems.Clear
                .FullRowSelect = True
                .GridLines = True
                .LabelEdit = lvwManual
                .View = lvwReport
                With .ColumnHeaders
                    .Clear
                    .Add , , "@", 0
                    .Add , , "名称", 1700
                    .Add , , "开票量", 1600
                    .Add , , "开票金额", 1600
                    .Add , , "开票修改量", 1600
                    .Add , , "开票修金额", 1600
                    .Add , , "开票作废量", 1800
                    .Add , , "开票作废金额", 1800
                    .Add , , "合计有效量", 1600
                    .Add , , "合计有效金额", 1600
                End With
            End With
        Case 1
    End Select
    
End Function

'显示数据
Private Function getDataList(strTab As String, iList As Integer)
    
    Dim rsTemp                     As New ADODB.Recordset
    Dim iIndex                     As Long
    Dim iSum1, iSum2, iSum3, iSum4, iSum5, iSum6, iSum7, iSum8, iSum9, iSum10 As Single
    Dim iCount                     As Long
    Set rsTemp = DBCN.Execute("Select * from " & strTab & "")
    If rsTemp.EOF = False Then
        iIndex = 1
        Select Case iList
            Case 0
                lstDataInfo.ListItems.Clear
                Do Until rsTemp.EOF
                    lstDataInfo.ListItems.Add iIndex, , iIndex
                    With lstDataInfo.ListItems(iIndex)
                        .SubItems(1) = IIf(IsNull(rsTemp.Fields("Oper_ID")), "", rsTemp.Fields("Oper_ID"))
                        .SubItems(2) = rsTemp.Fields("iCount")
                        iSum1 = iSum1 + Val(.SubItems(2))
                        .SubItems(3) = Format(rsTemp.Fields("iWeight"), "0.00")
                        iSum2 = iSum2 + Val(.SubItems(3))
                        .SubItems(4) = rsTemp.Fields("iCount1")
                        iSum3 = iSum3 + Val(.SubItems(4))
                        .SubItems(5) = Format(rsTemp.Fields("iChange"), "0.00")
                        iSum4 = iSum4 + Val(.SubItems(5))
                        .SubItems(6) = rsTemp.Fields("iCount2")
                        iSum5 = iSum5 + Val(.SubItems(6))
                        .SubItems(7) = Format(rsTemp.Fields("iCash"), "0.00")
                        iSum6 = iSum6 + Val(.SubItems(7))
                        .SubItems(8) = Format(Val(.SubItems(2)) + Val(.SubItems(4)), "0.00")
                        iSum7 = iSum7 + Val(.SubItems(8))
                        .SubItems(9) = Format(Val(.SubItems(3)) + Val(.SubItems(5)), "0.00")
                        iSum8 = iSum8 + Val(.SubItems(9))
                    End With
                    rsTemp.MoveNext
                    iIndex = iIndex + 1
                Loop
                iCount = lstDataInfo.ListItems.Count + 1
                lstDataInfo.ListItems.Add iCount, , iCount
                lstDataInfo.ListItems(iCount).SubItems(1) = "          合计："
                lstDataInfo.ListItems(iCount).SubItems(2) = Format(iSum1, "0.00")
                lstDataInfo.ListItems(iCount).SubItems(3) = Format(iSum2, "0.00")
                lstDataInfo.ListItems(iCount).SubItems(4) = Format(iSum3, "0.00")
                lstDataInfo.ListItems(iCount).SubItems(5) = Format(iSum4, "0.00")
                lstDataInfo.ListItems(iCount).SubItems(6) = Format(iSum5, "0.00")
                lstDataInfo.ListItems(iCount).SubItems(7) = Format(iSum6, "0.00")
                lstDataInfo.ListItems(iCount).SubItems(8) = Format(iSum7, "0.00")
                lstDataInfo.ListItems(iCount).SubItems(9) = Format(iSum8, "0.00")
        End Select
    Else
        MsgBox "没有符合条件的数据！", vbInformation, "提示："
    End If
    
End Function

Private Sub SSTab1_Click(PreviousTab As Integer)
    
    Dim rsTemp                            As New ADODB.Recordset
    Dim iIndex                            As Long
    Dim iKP_ZC(), iKP_XG(), iKP_ZF()      As Single
    Dim iDataList                         As Integer
    
    Select Case SSTab1.Tab
        Case 1
            If getSQLString = False Then MsgBox "无数据显示！", vbInformation, "提示：": Exit Sub
            Set rsTemp = DBCN.Execute("Select * from " & strCountTab & "")
            Set rsTemp = DBCN.Execute("Select * from " & strCountTab & "")
            Set MSChart2.DataSource = rsTemp
            
            With MSChart2
                .RowCount = rsTemp.RecordCount
                .ColumnCount = 3
                .Column = 1
            End With
            MSChart2.ColumnLabel = "开票金额"
            MSChart2.Column = 2
            MSChart2.ColumnLabel = "开票修改金额"
            MSChart2.Column = 3
            MSChart2.ColumnLabel = "开票作废金额"

            If rsTemp.EOF = False Then
                iDataList = 1
                Do Until rsTemp.EOF
                    For iIndex = 1 To rsTemp.RecordCount
                        With MSChart2
                            .Row = iIndex
                            .RowLabel = rsTemp.Fields("Oper_ID")
                            .Column = iDataList
                            .Data = rsTemp.Fields("iWeight") / 10000
                            .Column = iDataList + 1
                            .Data = rsTemp.Fields("iChange") / 10000
                            .Column = iDataList + 1
                            .Data = rsTemp.Fields("iCash") / 10000
                        End With
                    Next
                    rsTemp.MoveNext
                    iIndex = iIndex + 1
                Loop
                
            End If
    End Select
    
End Sub