xtquery.frm

一套鞋厂的销售管理系统

            k = "SELECT order_list.Model,-Sum(Shop_Stock_Trans.[Count]) AS [Count], -Sum(Shop_Stock_Trans.[count]*Shop_Stock_Trans.Price) AS Total" & _
                " FROM (Shop_Stock_Trans LEFT JOIN order_list ON Shop_Stock_Trans.OrderCode = order_list.FullCode) LEFT JOIN Shop_Dossier ON Shop_Stock_Trans.Address = Shop_Dossier.code" & _
                " where Shop_Stock_Trans.Type='销售'" & IIf(s = "", "", " and " & s) & _
                " GROUP BY order_list.Model" & _
                " ORDER BY [Count] DESC"
            DisPlayQuery_SQL k, "型体|数量|金额|", "销售排行(型体)", s1, 0, , "0|1|1|", , "||00,000,000.00|"
        End If
        If Me.OptionLineXL Then
            k = "SELECT order_list.Former, -Sum(Shop_Stock_Trans.[Count]) AS [Count], -Sum(Shop_Stock_Trans.[count]*Shop_Stock_Trans.Price) AS Total" & _
                " FROM (Shop_Stock_Trans LEFT JOIN order_list ON Shop_Stock_Trans.OrderCode = order_list.FullCode)  LEFT JOIN Shop_Dossier ON Shop_Stock_Trans.Address = Shop_Dossier.code" & _
                " where Shop_Stock_Trans.Type='销售'" & IIf(s = "", "", " and " & s) & _
                " GROUP BY order_list.Former" & _
                " ORDER BY [Count] DESC"
            DisPlayQuery_SQL k, "系列|数量|金额|", "销售排行(系列)", s1, 0, , "0|1|1|", , "||00,000,000.00|"
        End If
        If Me.OptionLinePP Then
            k = "SELECT order_list.Brand, MIN(DISTINCT Order_Brand.BrandChina) AS BrandName,-Sum(Shop_Stock_Trans.[Count]) AS [Count], -Sum(Shop_Stock_Trans.[count]*Shop_Stock_Trans.Price) AS Total" & _
                " FROM ((Shop_Stock_Trans LEFT JOIN order_list ON Shop_Stock_Trans.OrderCode = order_list.FullCode) LEFT JOIN Order_Brand ON order_list.Brand = Order_Brand.BrandCode)  LEFT JOIN Shop_Dossier ON Shop_Stock_Trans.Address = Shop_Dossier.code" & _
                " where Shop_Stock_Trans.Type='销售'" & IIf(s = "", "", " and " & s) & _
                " GROUP BY order_list.Brand" & _
                " ORDER BY [Count] DESC"
            DisPlayQuery_SQL k, "品牌|名称|数量|金额|", "销售排行(品牌)", s1, 0, , "0|0|1|1|", , "|||00,000,000.00|"
        End If
        If Me.OptionLineJG Then
            k = "SELECT order_list.Season, MIN(DISTINCT Order_Season.SeasonName) AS SeasonName, -Sum(Shop_Stock_Trans.[Count]) AS [Count], -Sum(Shop_Stock_Trans.[count]*Shop_Stock_Trans.Price) AS Total" & _
                " FROM ((Shop_Stock_Trans LEFT JOIN order_list ON Shop_Stock_Trans.OrderCode = order_list.FullCode) LEFT JOIN Order_Season ON order_List.Season = Order_Season.SeasonCode)  LEFT JOIN Shop_Dossier ON Shop_Stock_Trans.Address = Shop_Dossier.code" & _
                " where Shop_Stock_Trans.Type='销售'" & IIf(s = "", "", " and " & s) & _
                " GROUP BY order_List.Season" & _
                " ORDER BY [Count] DESC"
            DisPlayQuery_SQL k, "季节|名称|数量|金额|", "销售排行(季节)", s1, 0, , "0|0|1|1|", , "|||00,000,000.00|"
        End If
    End If
    
sub_exit:
    Exit Sub
    
sub_err:
    MsgBox "您可能多选了不必要的条件？"
    GoTo sub_exit
    
End Sub

Private Function DoSqlString(ByVal vField As String, ByVal vType As String, ByVal vValue As String, Optional ByVal vFieldType As String = "CHAR")
    Dim s As String
    s = IIf(vFieldType = "INT", "", "'")
    Select Case vType
        Case "="
            If vFieldType = "DATE" Then
                DoSqlString = vField & "=" & s & Format(vValue, "MM/DD/YYYY") & s
            Else
                DoSqlString = vField & "=" & s & vValue & s
            End If
            Case "Between"
            KillString vValue
            If vFieldType = "DATE" Then
                DoSqlString = vField & ">=" & s & Format(QuickTranArray(1), "MM/DD/YYYY") & s & " and " & vField & "<=" & s & Format(QuickTranArray(2), "MM/DD/YYYY") & s
            Else
                DoSqlString = vField & ">=" & s & QuickTranArray(1) & s & " and " & vField & "<=" & s & QuickTranArray(2) & s
            End If
        Case "Like"
            DoSqlString = vField & " Like '%" & vValue & "%'"
        Case Else
            KillString vType
            If Left(vType, 3) = "MID" Then
                DoSqlString = "substring(" & vField & "," & QuickTranArray(2) & "," & QuickTranArray(3) & ")='" & vValue & "'"
            End If
            If Left(vType, 4) = "LEFT" Then
                DoSqlString = "substring(" & vField & ",1," & QuickTranArray(2) & ")='" & vValue & "'"
            End If
    End Select
End Function

Private Sub DoubleAdd_Click()
    Dim s As String
    SourceRst.Filter = "Class='" & SourceList.List(SourceList.ListIndex) & "'"
    KillString SourceRst![valuedisplay]
    s = FindSqlCodeDouble(SourceRst![DoSource], QuickTranArray(1), QuickTranArray(2), SourceRst![DisPlayHead])
    If s <> "" Then
        Me.DoubleList.AddItem QuickTranArray(2)
        DestArrayCount = DestArrayCount + 1
        ReDim Preserve DestArray(1 To 2, 1 To DestArrayCount)
        DestArray(1, DestArrayCount) = QuickTranArray(1)
        DestArray(2, DestArrayCount) = QuickTranArray(2)
    End If
End Sub

Private Sub DoubleDel_Click()
    Dim i As Long, j As Long
    If DoubleList.SelCount > 0 Then
        For i = DoubleList.ListIndex + 1 To DoubleList.ListCount - 1
            DestArray(1, i) = DestArray(1, i + 1)
            DestArray(2, i) = DestArray(2, i + 1)
        Next
        DestArrayCount = DestArrayCount - 1
        If DestArrayCount > 0 Then
        ReDim Preserve DestArray(1 To 2, 0 To DestArrayCount)
        End If
        DoubleList.RemoveItem DoubleList.ListIndex
    End If
End Sub

Private Sub Form_Load()
Me.Left = 0
Me.Top = 0
    Dim i As Long, j As Long
    
    With DestRst
        .Fields.Append "DoClass", adVarChar, 20
        .Fields.Append "DoType", adVarChar, 10
        .Fields.Append "DoValue", adVarChar, 100
        .Fields.Append "DisValue", adVarChar, 100
        .LockType = adLockOptimistic
        .CursorLocation = adUseServer
        .CursorType = adOpenStatic
        .Open
    End With
    PrintFilter "销售统计"
    Me.DateBegin = Date
    Me.DateEnd = Date
End Sub



Private Sub PrintSqlBox()
    Dim i As Long, j As Long, s As String, k As String, l As String, Rst1 As New ADODB.Recordset
    Dim a As Long, b As Long
    Me.WriteValue.Visible = False
    Me.WriteValueLabel.Visible = False
    Me.SqlList.Visible = False
    Me.DataBeginLabel.Visible = False
    Me.DateBegin.Visible = False
    Me.DateEnd.Visible = False
    Me.DateEndLabel.Visible = False
    Me.WriteValue.Visible = False
    Me.WriteValueLabel.Visible = False
    Me.DoubleList.Visible = False
    Me.DoubleAdd.Visible = False
    Me.DoubleDel.Visible = False
    Me.SqlList.Clear
    Me.DoubleList.Clear
    ReDim DestArray(1 To 2, 1 To 1)
    DestArrayCount = 0
'-----------------------------------------------------
    If SourceList.Selected(SourceList.ListIndex) Then
        SourceRst.Filter = "Class='" & SourceList.List(SourceList.ListIndex) & "'"
        DestRst.Filter = "DoClass='" & SourceList.List(SourceList.ListIndex) & "'"
        a = DestRst.RecordCount
        Select Case SourceRst![dotype]
            Case 0
                If SourceRst![DisplayType] = "1" Then
                    Me.DoubleList.Visible = True
                    Me.DoubleAdd.Visible = True
                    Me.DoubleDel.Visible = True
                    If a > 0 Then
                        DestRst.MoveFirst
                        For b = 1 To a
                            DoubleList.AddItem DestRst![DisValue]
                            DestArrayCount = DestArrayCount + 1
                            ReDim Preserve DestArray(1 To 2, 1 To DestArrayCount)
                            DestArray(1, DestArrayCount) = DestRst![dovalue]
                            DestArray(2, DestArrayCount) = DestRst![DisValue]
                            DestRst.MoveNext
                        Next
                    End If
                Else
                    Me.SqlList.Visible = True
                    KillString SourceRst![valuedisplay]
                    s = QuickTranArray(2)
                    k = QuickTranArray(1)
                    l = SourceRst![DoSource]
                    Rst1.Open l, GetConnect, adOpenStatic, adLockReadOnly
                    i = Rst1.RecordCount
                    'MsgBox i
                    If i > 0 Then
                        Rst1.MoveFirst
                        For j = 1 To i
                            If IsNull(Rst1.Fields(s).Value) Then
                            Else
                                SqlList.AddItem Rst1.Fields(s).Value
                                DestArrayCount = DestArrayCount + 1
                                ReDim Preserve DestArray(1 To 2, 1 To DestArrayCount)
                                DestArray(1, DestArrayCount) = Rst1.Fields(k).Value
                                DestArray(2, DestArrayCount) = Rst1.Fields(s).Value
                                If a > 0 Then
                                    DestRst.MoveFirst
                                    For b = 1 To a
                                        If DestRst![DisValue] = SqlList.List(SqlList.ListCount - 1) Then
                                            SqlList.Selected(SqlList.ListCount - 1) = True
                                        End If
                                        DestRst.MoveNext
                                    Next
                                End If
                            End If
                            Rst1.MoveNext
                        Next
                    End If
                End If
            Case 1
                Me.SqlList.Visible = True
                KillString SourceRst![valuedisplay]
                For i = 1 To QuickTranCount
                    If i Mod 2 = 0 Then
                        DestArray(2, DestArrayCount) = QuickTranArray(i)
                        SqlList.AddItem QuickTranArray(i)
                        If a > 0 Then
                            DestRst.MoveFirst
                            For b = 1 To a
                                If DestRst![DisValue] = QuickTranArray(i) Then
                                    SqlList.Selected(SqlList.ListCount - 1) = True
                                End If
                                DestRst.MoveNext
                            Next
                        End If
                    Else
                        DestArrayCount = DestArrayCount + 1
                        ReDim Preserve DestArray(1 To 2, 1 To DestArrayCount)
                        DestArray(1, DestArrayCount) = QuickTranArray(i)
                    End If
                Next
            Case 2
                Me.SqlList.Visible = True
                Me.SqlList.AddItem "是"
                Me.SqlList.AddItem "否"
                If a > 0 Then
                    DestRst.MoveFirst
                    For b = 1 To a
                        If DestRst![DisValue] = "是" Then
                            SqlList.Selected(0) = True
                        Else
                            SqlList.Selected(1) = True
                        End If
                        DestRst.MoveNext
                    Next
                End If
                DestArrayCount = 2
                ReDim DestArray(1 To 2, 1 To 2)
                DestArray(1, 1) = "-1"
                DestArray(1, 2) = "是"
                DestArray(2, 1) = "0"
                DestArray(2, 2) = "否"
            Case 3
                Me.DataBeginLabel.Visible = True
                Me.DateBegin.Visible = True
                If a > 0 Then
                    DestRst.MoveFirst
                    Me.DateBegin.Value = DestRst![DisValue]
               End If
            Case 4
                Me.DataBeginLabel.Visible = True
                Me.DateBegin.Visible = True
                Me.DateEndLabel.Visible = True
                Me.DateEnd.Visible = True
                If a > 0 Then
                    DestRst.MoveFirst
                    s = ""
                    j = 0
                    For i = 1 To Len(DestRst![DisValue])
                        If Mid(DestRst![DisValue], i, 1) = "|" Then
                            If j = 0 Then
                                Me.DateBegin.Value = s
                            End If
                            If j = 1 Then
                                Me.DateEnd.Value = s
                            End If
                            j = j + 1
                            s = ""
                        Else