frmls.frm

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

      Height          =   2580
      Left            =   3960
      TabIndex        =   24
      Top             =   4560
      Width           =   4575
      _Version        =   196617
      DataMode        =   2
      Col.Count       =   0
      AllowAddNew     =   -1  'True
      MultiLine       =   0   'False
      RowHeight       =   450
      Columns(0).Width=   3200
      Columns(0).DataType=   8
      Columns(0).FieldLen=   4096
      _ExtentX        =   8070
      _ExtentY        =   4551
      _StockProps     =   79
      Caption         =   "库存商品信息"
      BackColor       =   -2147483624
   End
   Begin VB.Label Label10 
      Caption         =   "品名"
      Height          =   210
      Left            =   630
      TabIndex        =   21
      Top             =   7350
      Width           =   570
   End
   Begin VB.Label Label9 
      Caption         =   "日期止"
      Height          =   240
      Left            =   8685
      TabIndex        =   15
      Top             =   5055
      Width           =   870
   End
   Begin VB.Label Label8 
      Caption         =   "日期起"
      Height          =   255
      Left            =   8670
      TabIndex        =   14
      Top             =   4605
      Width           =   945
   End
   Begin VB.Label Label7 
      AutoSize        =   -1  'True
      Caption         =   "时间起"
      Height          =   180
      Left            =   705
      TabIndex        =   13
      Top             =   1845
      Width           =   540
   End
   Begin VB.Label Label4 
      Caption         =   "时间止"
      Height          =   195
      Left            =   3675
      TabIndex        =   12
      Top             =   1830
      Width           =   435
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      Caption         =   "时间起"
      Height          =   180
      Left            =   0
      TabIndex        =   11
      Top             =   15
      Width           =   540
   End
   Begin VB.Label Label6 
      Caption         =   "时间止"
      Height          =   195
      Left            =   3015
      TabIndex        =   10
      Top             =   15
      Width           =   435
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "分店总库存"
      Height          =   180
      Left            =   5040
      TabIndex        =   7
      Top             =   7410
      Width           =   900
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "公司库存"
      Height          =   180
      Left            =   8970
      TabIndex        =   5
      Top             =   6675
      Width           =   720
   End
   Begin VB.Label Label1 
      Caption         =   "商品编码"
      Height          =   225
      Left            =   8955
      TabIndex        =   3
      Top             =   6270
      Width           =   900
   End
End
Attribute VB_Name = "frmLS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim RsTT As New ADODB.Recordset


Private Sub Command1_Click()
    On Error Resume Next
    Set RsTT = Nothing
    sSQL = "select 商品编码,品名,单位 from 商品主档 where 品名 like '%" & Trim(txtGName.Text) & "%'"
    RsTT.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    If Not RsTT.EOF Then
        Set DataGrid1.DataSource = RsTT
        DataGrid1.Refresh
    End If
    
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub


Private Sub Command3_Click()
    grdDET.PrintData ssPrintAllRows, True, True
End Sub

Private Sub DataGrid1_DblClick()
    Call RefLS
    Call RefStock
End Sub

Private Sub RefStock()
        Dim i, tt
        Dim GCode
    Dim vSizeC(0 To 8) As String
    On Error Resume Next
    vSizeC(0) = "S"
    vSizeC(1) = "M"
    vSizeC(2) = "L"
    vSizeC(3) = "XL"
    vSizeC(4) = "2XL"
    vSizeC(5) = "3XL"
    vSizeC(6) = "4XL"
    vSizeC(7) = "5XL"
    vSizeC(8) = "6XL"
    
    GCode = Trim(txtCode.Text)
    i = 0
        
    grdStock.Columns.RemoveAll
    grdStock.Columns.Add (0)
    grdStock.Columns(i).Width = 550
    grdStock.Columns(i).Locked = True
    grdStock.Columns(i).Name = "颜色"
    grdStock.Columns(i).Caption = "颜色"

    
    
    sSQL = "SELECT * FROM 商品主档 WHERE 商品编码='" & GCode & "'"
    Set RsTemp = Nothing
    Set RsTemp = OpenRS(sSQL)
    If RsTemp.EOF Then
        MsgBox "该商品编码不存在!" & vbCrLf & "请检查输入是否正确或查询商品编码.", vbExclamation, "提示窗口"
        Exit Sub
    End If

    
    If Not RsTemp("备用标志4") Then
        sSQL = "SELECT 尺寸 FROM 商品信息 where 商品编码='" & GCode & "' group by 尺寸"
        Set RsTemp = Nothing
        RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
        i = 1
        While Not RsTemp.EOF
            
            grdStock.Columns.Add (i)
            grdStock.Columns(i).Width = 550
            grdStock.Columns(i).DataType = 4
            grdStock.Columns(i).Name = Trim(RsTemp("尺寸"))
            grdStock.Columns(i).Caption = Trim(RsTemp("尺寸"))
            
            RsTemp.MoveNext
    
            i = i + 1
        Wend
    Else
        For i = 0 To 8
            
            grdStock.Columns.Add (i + 1)
            grdStock.Columns(i + 1).Width = 550
            grdStock.Columns(i + 1).DataType = 4
            grdStock.Columns(i + 1).Name = vSizeC(i)
            grdStock.Columns(i + 1).Caption = vSizeC(i)
        Next i
    End If
    sSQL = "SELECT 颜色 FROM 商品信息 where 商品编码='" & GCode & "' group by 颜色 "
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    While Not RsTemp.EOF
        grdStock.AddItem Trim(RsTemp("颜色"))
        RsTemp.MoveNext
    Wend
    grdStock.AllowAddNew = False
    
    If GetSetting("LSDSTAR", "库存设置", "配送库存计算", "1") = "1" Then
        sSQL = "select * from V_CalMainStore where 商品编码='" & GCode & "'"
    Else
        sSQL = "select * from 配送中心库存 where 商品编码='" & GCode & "'"
    End If

    'sSQL = "select * from 配送中心库存 where 商品编码='" & GCode & "'"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    While Not RsTemp.EOF
        grdStock.MoveFirst
        For i = 0 To grdStock.Rows - 1
'            grdStock.Row = i
            If grdStock.Columns("颜色").Text = Trim(RsTemp("颜色")) Then grdStock.Columns(Trim(RsTemp("尺寸"))).Value = RsTemp("数量")
            grdStock.MoveNext
        Next i
        RsTemp.MoveNext
    Wend

End Sub

Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
    txtCode.Text = RsTT("商品编码")
End Sub

Private Sub DataGrid1_Scroll(Cancel As Integer)
    txtCode.Text = RsTT("商品编码")
End Sub

Private Sub DataGrid1_SelChange(Cancel As Integer)
    txtCode.Text = RsTT("商品编码")
End Sub

Private Sub Form_Load()
    dtpEnd.Value = Now
    dtpbegin.Value = Now - 30
End Sub

Private Sub RefLS()
    On Error Resume Next
    Dim t, i
    Dim Vil
    
    
    txtMainStore.Text = ""
    txtChainStore.Text = ""
    
    If chkVil.Value And (Not chkUnVil.Value) Then
        Vil = " and 确认状态=1"
    ElseIf chkUnVil.Value And (Not chkVil.Value) Then
        Vil = " and 确认状态=0"
    Else
        Vil = ""
    End If
    
    If chkIN.Value And chkOut.Value Then
        sSQL = "select 类型,表单号,摘要,日期,商品编码,品名,单位,sum(数量) as 数量,单价,sum(金额) as 金额,备注 from (select '收入' as 类型,表单号,厂商编码 as 摘要,制表日期 as 日期,商品编码,品名,单位,sum(进货数量) as 数量,含税进价 as 单价 ,含税进价金额 as 金额, 备注 from lsjhd group by 厂商编码,表单号,制表日期,商品编码,品名,单位,含税进价,含税进价金额, 备注  " & _
            " union all select '发出'  as 类型,表单号,客户名称 as 摘要,制表日期 as 日期,商品编码,品名,单位,sum(数量) as 数量,单价 as 单价,金额 as 金额, 备注  from lsxsd group by 客户名称,表单号,制表日期,商品编码,品名,单位,单价,金额 , 备注 " & _
            " union all select '发出'  as 类型,表单号,分店名称 as 摘要,配送日期 as 日期,商品编码,品名,单位,sum(配送数量) as 数量,零售价 as 单价,售价金额 as 金额, 备注  from psd group by 分店名称,表单号,配送日期,商品编码,品名,单位,零售价,售价金额, 备注 ) as ut " & _
            " where 商品编码 ='" & Trim(txtCode.Text) & "' and 日期 between '" & Format(dtpbegin.Value, "yyyy-mm-dd") & "' and '" & Format(dtpEnd.Value, "yyyy-mm-dd") & "' group by 类型,表单号,摘要,日期,商品编码,品名,单位,单价, 备注  order by 日期 "
    ElseIf Not chkIN.Value And chkOut.Value Then
        sSQL = "select 类型,表单号,摘要,日期,商品编码,品名,单位,sum(数量) as 数量,单价,sum(金额) as 金额, 备注  from (select '发出'  as 类型,表单号,客户名称 as 摘要,制表日期 as 日期,商品编码,品名,单位,sum(数量) as 数量,单价 as 单价,金额 as 金额, 备注  from lsxsd group by 客户名称,表单号,制表日期,商品编码,品名,单位,单价,金额, 备注  " & _
            " union all select '发出'  as 类型,表单号,分店名称 as 摘要,配送日期 as 日期,商品编码,品名,单位,sum(配送数量) as 数量,零售价 as 单价,售价金额 as 金额, 备注  from psd group by 分店名称,表单号,配送日期,商品编码,品名,单位,零售价,售价金额, 备注 ) as ut " & _
            " where 商品编码 ='" & Trim(txtCode.Text) & "' and 日期 between '" & Format(dtpbegin.Value, "yyyy-mm-dd") & "' and '" & Format(dtpEnd.Value, "yyyy-mm-dd") & "' group by 类型,表单号,摘要,日期,商品编码,品名,单位,单价, 备注  order by 日期 "
    ElseIf chkIN.Value And Not chkOut.Value Then
        sSQL = "select 类型,表单号,摘要,日期,商品编码,品名,单位,sum(数量) as 数量,单价,sum(金额) as 金额, 备注  from (select '收入' as 类型,表单号,厂商编码 as 摘要,制表日期 as 日期,商品编码,品名,单位,sum(进货数量) as 数量,含税进价 as 单价 ,含税进价金额 as 金额, 备注  from lsjhd group by 厂商编码,表单号,制表日期,商品编码,品名,单位,含税进价,含税进价金额, 备注 ) as ut " & _
            " where 商品编码 ='" & Trim(txtCode.Text) & "' and 日期 between '" & Format(dtpbegin.Value, "yyyy-mm-dd") & "' and '" & Format(dtpEnd.Value, "yyyy-mm-dd") & "' group by 类型,表单号,摘要,日期,商品编码,品名,单位,单价, 备注  order by 日期 "
    ElseIf Not chkIN.Value And Not chkOut.Value Then
        Exit Sub
    End If
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    grdDET.RemoveAll
    While Not RsTemp.EOF
        Temp = ""
        For i = 0 To RsTemp.Fields.Count - 1
            Temp = Temp & RsTemp(i) & vbTab
        Next i
        If RsTemp("数量") < 0 Then
            Temp = "冲红" & vbTab & Temp
        Else
            Temp = "" & vbTab & Temp
        End If
        grdDET.AddItem Temp
        
        RsTemp.MoveNext
    Wend
    
    
    sSQL = "select sum(数量) as 数量 from 配送中心库存 " & _
        " where 商品编码 ='" & Trim(txtCode.Text) & "'"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    txtMainStore.Text = RsTemp(0)
    
    sSQL = "select sum(数量) as 数量 from 分店库存 " & _
        " where 商品编码 ='" & Trim(txtCode.Text) & "'"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    txtChainStore.Text = RsTemp(0)
    
'        sSQL = "select a.分店编码,b.分店名称,a.颜色,a.尺寸,sum(a.数量) as 数量 from 分店库存  as a" & _
'            " inner join 分店主档 as b on a.分店编码=b.分店编码 where 商品编码 ='" & Trim(txtCode.Text) & "' group by a.分店编码,b.分店名称,a.颜色,a.尺寸"
'        Set RsTemp = Nothing
'        RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
'        Set DataGrid1.DataSource = RsTemp
'        DataGrid1.Refresh
    
    
    sSQL = "select * from 商品主档 " & _
        " where 商品编码 ='" & Trim(txtCode.Text) & "'"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    stbMSG.Panels(1).Text = "零售价:" & RsTemp("零售价")
End Sub


Private Sub txtCode_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then Call RefLS
End Sub

Private Sub txtGName_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then Call Command1_Click
End Sub