frm-

注释：用VB开发的进销存系统源码

         Width           =   1188
         _ExtentX        =   2090
         _ExtentY        =   953
         _Version        =   131073
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Caption         =   "分析[&A]"
         ButtonStyle     =   3
         PictureAlignment=   6
      End
   End
End
Attribute VB_Name = "frm连锁店库存查询"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'*********************************
'           库存分析
'*********************************

Option Explicit

Public Rs As New ADODB.Recordset               '用于只打开单记录集时

Private strRptSQL As String

'生成查询条件
Private Function GenerateQuerySQL() As String
    Dim strTemp As String
    sSQL = "SELECT * FROM 分店库存"
    If txtQty.Text <> "" Then
        strTemp = strTemp & " 数量 " & _
                AnalyseCondition(txtQty.Text, False) & " AND "
    End If
    If cmbGroup.Text <> "" Then
        strTemp = strTemp & " 分店编码 " & _
                AnalyseCondition(cmbGroup.Text, True) & " AND "
    End If
    If txtIncode.Text <> "" Then
        strTemp = strTemp & " 商品编码 " & _
                AnalyseCondition(txtIncode.Text, True) & " AND "
    End If
    If txtSname.Text <> "" Then
        strTemp = strTemp & " 品名 " & _
                AnalyseCondition(txtSname.Text, True) & " AND "
    End If
    If txtIamt.Text <> "" Then
        strTemp = strTemp & " 进价金额 " & _
                AnalyseCondition(txtIamt.Text, False) & " AND "
    End If
    If txtRamt.Text <> "" Then
        strTemp = strTemp & " 含税进价金额 " & _
                AnalyseCondition(txtRamt.Text, False) & " AND "
    End If
    sSQL = sSQL & " WHERE " & strTemp & " 经营方式='" & cmbSaleStyle.Text & "'  ORDER BY 商品编码"
    GenerateQuerySQL = sSQL
End Function

'生成查询条件
Private Function GenerateQuerySQLBySingle() As String
    Dim strTemp As String
    sSQL = "SELECT 商品编码,品名,单位,SUM(数量) AS 数量,SUM(进价金额) AS 进价金额,SUM(含税进价金额) AS 含税进价金额 FROM 分店库存"
    If txtSingleQty.Text <> "" Then
        strTemp = strTemp & " 数量 " & _
                AnalyseCondition(txtSingleQty.Text, False) & " AND "
    End If
    
    If txtSingleIncode.Text <> "" Then
        strTemp = strTemp & " 商品编码 " & _
                AnalyseCondition(txtSingleIncode.Text, True) & " AND "
    End If
    If txtSingleSname.Text <> "" Then
        strTemp = strTemp & " 品名 " & _
                AnalyseCondition(txtSingleSname.Text, True) & " AND "
    End If
    If txtSingleIamt.Text <> "" Then
        strTemp = strTemp & " 进价金额 " & _
                AnalyseCondition(txtSingleIamt.Text, False) & " AND "
    End If
    If txtSingleRamt.Text <> "" Then
        strTemp = strTemp & " 含税进价金额 " & _
                AnalyseCondition(txtSingleRamt.Text, False) & " AND "
    End If
    
    sSQL = sSQL & " WHERE " & strTemp & " 经营方式='" & cmbSingleSaleStyle.Text & "'"
    sSQL = sSQL & " GROUP BY 商品编码,品名,单位  ORDER BY 商品编码"
    GenerateQuerySQLBySingle = sSQL
End Function

'生成查询条件
Private Function GenerateQuerySQLByGroup() As String
    Dim strTemp As String
    sSQL = "SELECT 商品编码,品名,单位,SUM(数量) AS 数量,SUM(进价金额) AS 进价金额,SUM(含税进价金额) AS 含税进价金额 FROM 分店库存"
    
    If cmbGrpGrpno.Text <> "" Then
        strTemp = strTemp & " 分店编码 " & _
                AnalyseCondition(cmbGrpGrpno.Text, True) & " AND "
    End If
    
    If txtGrpIncode.Text <> "" Then
        strTemp = strTemp & " 商品编码 " & _
                AnalyseCondition(txtGrpIncode.Text, True) & " AND "
    End If
    If txtGrpSname.Text <> "" Then
        strTemp = strTemp & " 品名 " & _
                AnalyseCondition(txtGrpSname.Text, True) & " AND "
    End If
    sSQL = sSQL & " WHERE " & strTemp & " 经营方式='" & cmbGrpSaleStyle.Text & "'"
    sSQL = sSQL & " GROUP BY 分店编码,商品编码,品名,单位  ORDER BY 商品编码"
    GenerateQuerySQLByGroup = sSQL
End Function


Private Sub cmbBigType_Click()
    On Error Resume Next
    sSQL = "SELECT 本节点编码,本节点名称 FROM 商品分类表 WHERE 级别=2 AND 父节点名称='" & Trim(cmbBigType.Columns(1).Text) & "'"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    cmbMidType.RemoveAll
    While Not RsTemp.EOF
        cmbMidType.AddItem RsTemp("本节点编码") & vbTab & Trim(RsTemp("本节点名称"))
        RsTemp.MoveNext
    Wend
End Sub

Private Sub cmbBigType_InitColumnProps()
    On Error Resume Next
    sSQL = "SELECT 本节点编码,本节点名称 FROM 商品分类表 WHERE 级别=1"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    While Not RsTemp.EOF
        cmbBigType.AddItem RsTemp("本节点编码") & vbTab & Trim(RsTemp("本节点名称"))
        RsTemp.MoveNext
    Wend
End Sub


Private Sub cmbGroup_CloseUp()
    TxtName.Text = cmbGroup.Columns(1).Text
End Sub

Private Sub cmbGroup_GotFocus()
    cmbGroup.DroppedDown = True
End Sub

Private Sub cmbGroup_InitColumnProps()
    On Error GoTo LinkErr
    Set Rs = Nothing
    Rs.Open "SELECT * FROM 分店主档", Conn, adOpenStatic, adLockReadOnly
    While Not Rs.EOF
        cmbGroup.AddItem Rs("分店编码") + vbTab + Rs("分店名称")
        Rs.MoveNext
    Wend
    Exit Sub
LinkErr:
    MsgBox "初始化数据错误！" & Err.Description, vbExclamation, "错误窗口"
End Sub

Private Sub cmbGrpGrpno_CloseUp()
    TxtGName.Text = cmbGrpGrpno.Columns(1).Text
End Sub

Private Sub cmbGrpGrpno_InitColumnProps()
    On Error GoTo LinkErr
    Set Rs = Nothing
    Rs.Open "SELECT * FROM 分店主档", Conn, adOpenStatic, adLockReadOnly
    While Not Rs.EOF
        cmbGrpGrpno.AddItem Rs("分店编码") + vbTab + Rs("分店名称")
        Rs.MoveNext
    Wend
    Exit Sub
LinkErr:
    MsgBox "初始化数据错误！" & Err.Description, vbExclamation, "错误窗口"

End Sub

Private Sub cmbGrpSaleStyle_InitColumnProps()
    cmbGrpSaleStyle.AddItem "经销"
    cmbGrpSaleStyle.AddItem "代销"
End Sub


Private Sub cmbSaleStyle_InitColumnProps()
    cmbSaleStyle.AddItem "经销"
    cmbSaleStyle.AddItem "代销"
End Sub

Private Sub cmbSaleStyle2_InitColumnProps()
    cmbSaleStyle2.AddItem "经销"
    cmbSaleStyle2.AddItem "代销"

End Sub

Private Sub cmbSingleSaleStyle_InitColumnProps()
    cmbSingleSaleStyle.AddItem "经销"
    cmbSingleSaleStyle.AddItem "代销"

End Sub

Private Sub cmdAnalyse_Click()
    frm库存占用分析.Show
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub


Private Sub cmdPrint_Click()
    Select Case tabQuery.Caption
        Case "综合查询"
            grdDET.PrintData ssPrintAllRows, True, False
        Case "按单品查询"
            grdSingle.PrintData ssPrintAllRows, True, False
        Case "按分类查询"
            grdType.PrintData ssPrintAllRows, True, False
        Case "按连锁店查询"
            grdGrpDET.PrintData ssPrintAllRows, True, False
    End Select
End Sub

Private Sub cmdQuery_Click()
    Select Case tabQuery.Caption
        Case "综合查询"
            If cmbSaleStyle.Text = "" Then
                MsgBox "请选择销售方式!", vbExclamation, "提示窗口"
                Exit Sub
            End If
            sSQL = GenerateQuerySQL()
            strRptSQL = sSQL
            Set Rs = Nothing
            Rs.Open sSQL, Conn, adOpenStatic, adLockReadOnly
            grdDET.RemoveAll
            If Rs.EOF Then
                MsgBox "无匹配记录！", vbInformation, "提示窗口"
                Exit Sub
            End If
            txtSumIamt.Text = ""
            txtSumRamt.Text = ""
            While Not Rs.EOF
                grdDET.AddItem Rs("分店编码") & vbTab & _
                                Rs("商品编码") & vbTab & _
                                Rs("品名") & vbTab & _
                                Rs("单位") & vbTab & _
                                Rs("数量") & vbTab & _
                                Rs("进价金额") & vbTab & _
                                Rs("含税进价金额")
                txtSumIamt.Text = Format(Val(txtSumIamt.Text) + Rs("进价金额"), DecNum)
                txtSumRamt.Text = Format(Val(txtSumRamt.Text) + Rs("含税进价金额"), DecNum)
                Rs.MoveNext
            Wend
        Case "按单品查询"
            If cmbSingleSaleStyle.Text = "" Then
                MsgBox "请选择销售方式!", vbExclamation, "提示窗口"
                Exit Sub
            End If
            sSQL = GenerateQuerySQLBySingle()
            strRptSQL = sSQL
            Set RsTemp = Nothing
            RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
            grdSingle.RemoveAll
            If RsTemp.EOF Then
                MsgBox "无匹配记录！", vbInformation, "提示窗口"
                Exit Sub
            End If
            txtSingleSumIamt.Text = ""
            txtSingleSumRamt.Text = ""
            While Not RsTemp.EOF
                grdSingle.AddItem RsTemp("商品编码") & vbTab & _
                                RsTemp("品名") & vbTab & _
                                RsTemp("单位") & vbTab & _
                                RsTemp("数量") & vbTab & _
                                RsTemp("进价金额") & vbTab & _
                                RsTemp("含税进价金额")
                txtSingleSumIamt.Text = Format(Val(txtSingleSumIamt.Text) + RsTemp("进价金额"), DecNum)
                txtSingleSumRamt.Text = Format(Val(txtSingleSumRamt.Text) + RsTemp("含税进价金额"), DecNum)
                RsTemp.MoveNext
            Wend

        Case "按分类查询"
            Dim MyTemp1, MyTemp2, MyTemp3
            If cmbSaleStyle2.Text = "" Then
                MsgBox "请选择销售方式!", vbExclamation, "提示窗口"
                Exit Sub
            End If
            
            If cmbBigType.Text <> "" Then
                If cmbMidType.Text <> "" Then
                   MyTemp1 = " WHERE SUBSTRING(商品编码,3,2)='" & Trim(cmbBigType.Columns(0).Text) & Trim(cmbMidType.Columns(0).Text) & "' AND 经营方式='" & cmbSaleStyle2.Text & "'"
                   sSQL = "SELECT SUBSTRING(商品编码,3,2) AS 分类编码,SUM(数量) AS 数量,SUM(进价金额) AS 进价金额,SUM(含税进价金额) AS 含税进价金额 FROM 分店库存" & _
                        MyTemp1 & _
                        " GROUP BY SUBSTRING(商品编码,3,2) "
                Else
                   MyTemp1 = " WHERE SUBSTRING(商品编码,3,1)='" & Trim(cmbBigType.Columns(0).Text) & "' AND 经营方式='" & cmbSaleStyle2.Text & "'"
                   sSQL = "SELECT SUBSTRING(商品编码,3,1) AS 分类编码,SUM(数量) AS 数量,SUM(进价金额) AS 进价金额,SUM(含税进价金额) AS 含税进价金额 FROM 分店库存" & _
                        MyTemp1 & _
                        " GROUP BY SUBSTRING(商品编码,3,1) "
                End If
            Else
                sSQL = "SELECT SUBSTRING(商品编码,3,1) AS 分类编码,SUM(数量) AS 数量,SUM(进价金额) AS 进价金额,SUM(含税进价金额) AS 含税进价金额 FROM 分店库存" & _
                        " WHERE 经营方式='" & cmbSaleStyle2.Text & "'" & _
                        " GROUP BY SUBSTRING(商品编码,3,1) "
            End If

            strRptSQL = sSQL
            Set RsTemp = Nothing
            RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
            grdType.RemoveAll
            If RsTemp.EOF Then
                MsgBox "无匹配记录！", vbInformation, "提示窗口"
                Exit Sub
            End If
            txtIamt2.Text = ""
            txtRamt2.Text = ""
            While Not RsTemp.EOF
                grdType.AddItem RsTemp("分类编码") & vbTab & _
                                RsTemp("数量") & vbTab & _
                                RsTemp("进价金额") & vbTab & _
                                RsTemp("含税进价金额")
                txtIamt2.Text = Format(Val(txtIamt2.Text) + RsTemp("进价金额"), DecNum)
                txtRamt2.Text = Format(Val(txtRamt2.Text) + RsTemp("含税进价金额"), DecNum)
                RsTemp.MoveNext
            Wend

        Case "按连锁店查询"
            If cmbGrpSaleStyle.Text = "" Then
                MsgBox "请选择销售方式!", vbExclamation, "提示窗口"
                Exit Sub
            End If
            If cmbGrpGrpno.Text = "" Then
                MsgBox "请选择部门!", vbExclamation, "提示窗口"
                Exit Sub
            End If
            sSQL = GenerateQuerySQLByGroup()
            strRptSQL = sSQL
            Set Rs = Nothing
            Rs.Open sSQL, Conn, adOpenStatic, adLockReadOnly
            grdGrpDET.RemoveAll
            If Rs.EOF Then
                MsgBox "无匹配记录！", vbInformation, "提示窗口"
                Exit Sub
            End If
            txtGrpSumIamt.Text = ""
            txtGrpSumRamt.Text = ""
            While Not Rs.EOF
                grdGrpDET.AddItem Rs("商品编码") & vbTab & _
                                Rs("品名") & vbTab & _
                                Rs("单位") & vbTab & _
                                Rs("数量") & vbTab & _
                                Rs("进价金额") & vbTab & _
                                Rs("含税进价金额")
                txtGrpSumIamt.Text = Format(Val(txtGrpSumIamt.Text) + Rs("进价金额"), DecNum)
                txtGrpSumRamt.Text = Format(Val(txtGrpSumRamt.Text) + Rs("含税进价金额"), DecNum)
                Rs.MoveNext
            Wend

    End Select
    
End Sub


Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        SendKeys "{TAB}"
    End If
End Sub


Private Sub Form_Load()
    Call SetFormToCenter(Me)
End Sub

Private Sub txtRamt_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        Call cmdQuery_Click
    End If
End Sub