frmchainps.frm

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

            SubFormatType   =   0
         EndProperty
      EndProperty
      SplitCount      =   1
      BeginProperty Split0 
         BeginProperty Column00 
         EndProperty
         BeginProperty Column01 
         EndProperty
      EndProperty
   End
   Begin SSDataWidgets_B_OLEDB.SSOleDBGrid grdS 
      Height          =   1770
      Index           =   4
      Left            =   45
      TabIndex        =   16
      Top             =   4305
      Width           =   4710
      _Version        =   196617
      DataMode        =   2
      Col.Count       =   0
      AllowAddNew     =   -1  'True
      RowHeight       =   450
      Columns(0).Width=   3200
      _ExtentX        =   8308
      _ExtentY        =   3122
      _StockProps     =   79
      Caption         =   "分店三"
   End
   Begin SSDataWidgets_B_OLEDB.SSOleDBGrid grdS 
      Height          =   2160
      Index           =   5
      Left            =   3930
      TabIndex        =   17
      Top             =   6090
      Width           =   2925
      _Version        =   196617
      DataMode        =   2
      Col.Count       =   0
      AllowAddNew     =   -1  'True
      RowHeight       =   450
      Columns(0).Width=   3200
      Columns(0).DataType=   8
      Columns(0).FieldLen=   4096
      _ExtentX        =   5159
      _ExtentY        =   3810
      _StockProps     =   79
      Caption         =   "合计"
      BeginProperty PageFooterFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty PageHeaderFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Label Label3 
      Caption         =   "时间止"
      Height          =   240
      Left            =   7725
      TabIndex        =   9
      Top             =   7530
      Width           =   660
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "商品编码"
      Height          =   180
      Left            =   7605
      TabIndex        =   8
      Top             =   6885
      Width           =   720
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "时间起"
      Height          =   180
      Left            =   7710
      TabIndex        =   6
      Top             =   7245
      Width           =   540
   End
End
Attribute VB_Name = "frmChainPS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim RRR As New ADODB.Recordset

Private Sub Command1_Click()
    On Error Resume Next
    Dim I, j, N, c
    For I = 0 To 5
        grdS(I).Columns.RemoveAll
        grdS(I).Columns.Add (0)
        grdS(I).Columns(0).Width = 550
        grdS(I).Columns(0).Locked = True
        grdS(I).Columns(0).Name = "颜色"
        grdS(I).Columns(0).Caption = "颜色"
        grdS(I).Caption = "无"
    Next I
    
    grdS(5).Caption = "合计"
    
    sSQL = "SELECT 尺寸 FROM 商品信息 where 商品编码='" & txtCode.Text & "' group by 尺寸 order by  尺寸 desc"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    I = 1

    For j = 0 To 5
        RsTemp.MoveFirst
        While Not RsTemp.EOF
            grdS(j).Columns.Add (I)
            grdS(j).Columns(I).Width = 550
            grdS(j).Columns(I).DataType = 4
            grdS(j).Columns(I).Name = Trim(RsTemp("尺寸"))
            grdS(j).Columns(I).Caption = Trim(RsTemp("尺寸"))
            RsTemp.MoveNext
        Wend
    Next j
    sSQL = "SELECT 颜色 FROM 商品信息 where 商品编码='" & txtCode.Text & "' group by 颜色 "
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    For j = 0 To 5
        RsTemp.MoveFirst
        While Not RsTemp.EOF
            grdS(j).AddItem Trim(RsTemp("颜色"))
            RsTemp.MoveNext
        Wend
    Next j
    
    c = 0
    grdChainInfo.MoveFirst
    For N = 0 To grdChainInfo.Rows - 1
        If grdChainInfo.Columns("选择标志").Value = -1 And c < 5 Then
            sSQL = "select 颜色,尺寸,sum(配送数量) as 配送数量 from psd where 商品编码='" & txtCode.Text & "' and 分店编码='" & Trim(grdChainInfo.Columns("分店编码").Text) & "' and 配送日期 between '" & Format(dtpBegin.Value, "yyyy-mm-dd") & "' and '" & Format(dtpEnd.Value, "yyyy-mm-dd") & "' group by 颜色,尺寸"
            Set RsTemp = Nothing
            RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
            
            grdS(c).Caption = grdChainInfo.Columns("分店名称").Text
            While Not RsTemp.EOF
                grdS(c).MoveFirst
                For I = 0 To grdS(c).Rows - 1
                    'grdSale.Row = i
                    If grdS(c).Columns("颜色").Text = Trim(RsTemp("颜色")) Then grdS(c).Columns(Trim(RsTemp("尺寸"))).Value = RsTemp("配送数量")
                    grdS(c).MoveNext
                Next I
                RsTemp.MoveNext
            Wend
            c = c + 1
        End If
        grdChainInfo.MoveNext
    Next N
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub

Private Sub Command3_Click()
    On Error Resume Next
    Dim sSQL As String
    sSQL = "select 制表日期,商品编码,品名,单位 from lsjhd group by 制表日期,商品编码,品名,单位 order by 制表日期 desc"
    Set RRR = Nothing
    RRR.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    Set DataGrid1.DataSource = RRR
    DataGrid1.Refresh

End Sub

Private Sub Command4_Click()
        On Error Resume Next
    Dim I, j, N, m, c
    grdS(5).Update
    grdS(5).MoveFirst
    For m = 0 To 5
        grdS(m).Row = 0
'        grdS(i).MoveFirst
    Next m
    For I = 0 To grdS(5).Rows - 1
        For j = 1 To grdS(5).Columns.Count - 1
            c = 0
            For N = 0 To 4
               If grdS(N).Columns(j).CellValue(grdS(N).GetBookmark(I)) <> "" Then c = c + Val(grdS(N).Columns(j).CellValue(grdS(N).GetBookmark(I)))
            Next N
            grdS(5).Columns(j).Text = c
        Next j
        grdS(5).MoveNext
    Next I
End Sub

Private Sub Command5_Click()
    On Error Resume Next
    Dim N, I, StrTemp
    
    grdS(5).MoveFirst
    For I = 0 To grdS(5).Rows - 1
        For N = 1 To grdS(5).Columns.Count - 1
            grdS(5).Columns(N).Value = ""
        Next N
        grdS(5).MoveNext
    Next I
            
    
    sSQL = "select 颜色,尺寸,sum(配送数量) as 数量 from psd where 商品编码='" & txtCode.Text & "'  and 配送日期 between '" & Format(dtpBegin.Value, "yyyy-mm-dd") & "' and '" & Format(dtpEnd.Value, "yyyy-mm-dd") & "'"
    StrTemp = ""
    grdChainInfo.MoveFirst
    
    For N = 0 To grdChainInfo.Rows - 1
        If grdChainInfo.Columns("选择标志").Value = -1 Then StrTemp = StrTemp & " 分店编码='" & Trim(grdChainInfo.Columns("分店编码").Text) & "' or"
        grdChainInfo.MoveNext
    Next N
    
    If StrTemp <> "" Then
        StrTemp = Mid(StrTemp, 1, Len(StrTemp) - 2)
        sSQL = sSQL & " and " & StrTemp & " group by 颜色,尺寸"
    End If
    
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    While Not RsTemp.EOF
        grdS(5).MoveFirst
        For I = 0 To grdS(5).Rows - 1
            'grdSale.Row = i
            If grdS(5).Columns("颜色").Text = Trim(RsTemp("颜色")) Then grdS(5).Columns(Trim(RsTemp("尺寸"))).Value = RsTemp("数量")
            grdS(5).MoveNext
        Next I
        RsTemp.MoveNext
    Wend
End Sub

Private Sub DataGrid1_DblClick()
    On Error Resume Next
    txtCode.Text = RRR("商品编码")
    Call Command1_Click

End Sub

Private Sub Form_Load()
    On Error Resume Next
    dtpBegin.Value = Now
    dtpEnd.Value = Now
    sSQL = "select * from 分店主档 order by 分店编码"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    While Not RsTemp.EOF
        grdChainInfo.AddItem "" & vbTab & RsTemp("分店编码") & vbTab & RsTemp("分店名称")
        RsTemp.MoveNext
    Wend
End Sub

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