frm

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

    For i = 0 To grdDET.Rows - 1
        If Not InSubStock(cmbGroup.Text, grdDET.Columns("商品编码").Text, grdDET.Columns("商品名称").Text, _
            grdDET.Columns("单位").Text, grdDET.Columns("颜色").Text, grdDET.Columns("尺寸").Text, grdDET.Columns("数量").Value, grdDET.Columns("单价").Value, 0) Then
            MsgBox "保存销售数据时发生错误!!", vbExclamation, "错误窗口"
            Conn.RollbackTrans
            SaveTable = False
            Exit Function
        End If
        
        sSQL = "UPDATE 分店商品信息 SET 配送价=" & Val(grdDET.Columns("单价").Text) & _
            " WHERE 商品编码='" & Trim(grdDET.Columns("商品编码").Text) & "' and 分店编码='" & Trim(cmbGroup.Text) & "'"
        Cmd.ActiveConnection = Conn
        Cmd.CommandText = sSQL
        Cmd.Execute
        
        grdDET.MoveNext
    Next i
    SaveTable = True
    Conn.CommitTrans
    Exit Function
SaveErr:
    MsgBox "保存销售数据时发生错误!!", vbExclamation, "错误窗口"
    Conn.RollbackTrans
    SaveTable = False
End Function

Private Sub cmbGroup_Change()
    Set RsTemp = Nothing
    RsTemp.Open "select 电话 from 分店主档 where 分店编码='" & Trim(cmbGroup.Columns(0).Text) & "'", Conn, adOpenStatic, adLockReadOnly
    JD = RsTemp("电话")

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 cmdToolAdd_Click()
    cmbGroup.Text = ""
    grdDET.RemoveAll
    cmdToolSave.Enabled = True
    cmdToolDelete.Enabled = True
End Sub


Private Sub cmdToolDelete_Click()
    On Error GoTo DeleteErr
    If cmbGroup.Text = "" Then
        MsgBox "请先选择分店!!", vbInformation, "提示窗口"
        Exit Sub
    End If
    Temp = "分店编码：" & cmbGroup.Text & vbCrLf
    If MsgBox("确定要删除以下库存信息吗？" & Temp, vbQuestion + vbYesNo, "提示窗口") = vbNo Then Exit Sub
    sSQL = "DELETE 分店库存 WHERE " & _
            " 分店编码='" & cmbGroup.Text & "'"
    Cmd.ActiveConnection = Conn
    Cmd.CommandText = sSQL
    Cmd.Execute
    Exit Sub
DeleteErr:
    MsgBox "删除错误!!", vbExclamation, "错误窗口"
End Sub

Private Sub cmdToolExit_Click()
    Unload Me
End Sub

Private Sub cmdToolJian_Click()
    Dim s, ss, Qty, prc, i
    Load frmDist
    'Set frmDist.frm = Me
    frmDist.Show 1
    sSQL = "SELECT 品名,单位,进价,零售价,税率,含税进价 FROM 商品主档 WHERE 商品编码='" & frmDist.GCode & "'"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockOptimistic
    
    If RsTemp.EOF Then
        MsgBox "该商品编码不存在!" & vbCrLf & "请检查输入是否正确或查询商品编码.", vbExclamation, "提示窗口"
        Exit Sub
    End If
        If frmDist.R <> "" Then
            
'            sSQL = "select * from 分店商品信息 where 商品编码='" & Trim(grdDET.Columns("商品编码").Text) & "' and 分店编码='" & Trim(cmbGroup.Text) & "'"
'            Set RsTemp = Nothing
'            RsTemp.Open sSQL, Conn, adOpenStatic, adLockOptimistic
            
'            If Not RsTemp.EOF Then prc = RsTemp("配送价")
            sSQL = "SELECT * FROM 商品主档 WHERE 商品编码='" & Trim(frmSelectGoods.GCode) & "'"
            Set RsTemp = Nothing
            RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
            If RsTemp.EOF Then
                MsgBox "该商品编码不存在！" & grdDET.Columns("商品编码").Text & "!", vbExclamation, "提示窗口"
                Exit Sub
            End If
    '
    '        prc = RsTemp("含税进价")
            
            Load frmChainPrc
            Call frmChainPrc.InitData(frmSelectGoods.GCode, cmbGroup.Text)
            frmChainPrc.Show 1
            prc = frmChainPrc.prc

            
            ss = frmDist.R
            
            i = 1
            While i <= Len(ss)
                s = ""
                Qty = ""
                While Mid(ss, i, 1) <> "#" And i <= Len(ss)
                    If Mid(ss, i, 1) = "@" Then
                        s = s & vbTab
                    ElseIf Mid(ss, i, 1) = "$" Then
                        Qty = ""
                        s = s & vbTab & Str(prc) & vbTab
                    Else
                        Qty = Qty & Mid(ss, i, 1)
                        s = s & Mid(ss, i, 1)
                    End If
                    i = i + 1
                Wend
                i = i + 1
                Temp = frmDist.GCode & vbTab & RsTemp("品名") & vbTab & _
                        RsTemp("单位") & vbTab & s & vbTab & Str(Qty * RsTemp("含税进价")) & vbTab & Str(Qty * prc)
                grdDET.AddItem Temp
            Wend
        End If
        Unload frmDist

End Sub

Private Sub cmdToolQuery_Click()
    On Error Resume Next
    If cmbGroup.Text = "" Then
        MsgBox "请先选择分店!!", vbInformation, "提示窗口"
        Exit Sub
    End If
    sSQL = "SELECT a.商品编码,a.品名,a.单位,a.颜色,a.尺寸,a.数量,a.售价金额,a.售价金额/a.数量 as 配送价 FROM 分店库存  " & _
            " as a WHERE " & _
            " a.分店编码='" & cmbGroup.Text & "' and a.数量<>0 ORDER BY a.商品编码"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    If RsTemp.EOF Then
        MsgBox "未发现匹配记录!!", vbInformation, "提示窗口"
        grdDET.RemoveAll
        Exit Sub
    End If
    grdDET.RemoveAll
    While Not RsTemp.EOF
        grdDET.AddItem RsTemp("商品编码") & vbTab & _
                        RsTemp("品名") & vbTab & _
                        RsTemp("单位") & vbTab & _
                        RsTemp("颜色") & vbTab & _
                        RsTemp("尺寸") & vbTab & _
                        RsTemp("配送价") & vbTab & _
                        RsTemp("数量") & vbTab & _
                        RsTemp("售价金额")
        RsTemp.MoveNext
    Wend
    
End Sub

Private Sub cmdToolSave_Click()
    On Error Resume Next
    If cmbGroup.Text = "" Then
        MsgBox "请先选择部门!!", vbInformation, "提示窗口"
        Exit Sub
    End If
    sSQL = "SELECT * FROM 分店库存 WHERE " & _
            " 分店编码='" & cmbGroup.Text & "'"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    If Not RsTemp.EOF Then
        If MsgBox("该销售数据已经存在!覆盖吗？", vbQuestion + vbYesNo, "提示窗口") = vbNo Then Exit Sub
'        Conn.BeginTrans
'        sSQL = "DELETE 分店库存 WHERE " & _
'            " 分店编码='" & cmbGroup.Text & "'"
'        Cmd.ActiveConnection = Conn
'        Cmd.CommandText = sSQL
'        Cmd.Execute
    End If
    If Not SaveTable() Then
        MsgBox "保存失败!!，请检查数据是否存在错误!!", vbExclamation, "错误窗口"
        Conn.RollbackTrans
        Exit Sub
    End If
'        Conn.CommitTrans
    cmdToolDelete.Enabled = True
End Sub


Private Sub cmdToolSelect_Click()
    Dim s, ss, Qty, prc, i
    Load frmSelectGoods
    'Set frmSelectGoods.frm = Me
    frmSelectGoods.Show 1
    sSQL = "SELECT 品名,单位,进价,零售价,税率,含税进价 FROM 商品主档 WHERE 商品编码='" & frmSelectGoods.GCode & "'"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockOptimistic
    
    If RsTemp.EOF Then
        MsgBox "该商品编码不存在!" & vbCrLf & "请检查输入是否正确或查询商品编码.", vbExclamation, "提示窗口"
        Exit Sub
    End If
    
    grdDET.Update
        If frmSelectGoods.R <> "" Then
            
'            sSQL = "select * from 分店商品信息 where 商品编码='" & Trim(grdDET.Columns("商品编码").Text) & "' and 分店编码='" & Trim(cmbGroup.Text) & "'"
'            Set RsTemp = Nothing
'            RsTemp.Open sSQL, Conn, adOpenStatic, adLockOptimistic
'
'            If Not RsTemp.EOF Then prc = RsTemp("配送价")
'
'            prc = RsTemp("含税进价")
            sSQL = "SELECT * FROM 商品主档 WHERE 商品编码='" & Trim(frmSelectGoods.GCode) & "'"
            Set RsTemp = Nothing
            RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
            If RsTemp.EOF Then
                MsgBox "该商品编码不存在！" & grdDET.Columns("商品编码").Text & "!", vbExclamation, "提示窗口"
                Exit Sub
            End If
    '
    '        prc = RsTemp("含税进价")
            
            Load frmChainPrc
            Call frmChainPrc.InitData(frmSelectGoods.GCode, cmbGroup.Text)
            frmChainPrc.Show 1
            prc = frmChainPrc.prc

            
            ss = frmSelectGoods.R
            
            i = 1
            While i <= Len(ss)
                s = ""
                Qty = ""
                While Mid(ss, i, 1) <> "#" And i <= Len(ss)
                    If Mid(ss, i, 1) = "@" Then
                        s = s & vbTab
                    ElseIf Mid(ss, i, 1) = "$" Then
                        Qty = ""
                        s = s & vbTab & Str(prc) & vbTab
                    Else
                        Qty = Qty & Mid(ss, i, 1)
                        s = s & Mid(ss, i, 1)
                    End If
                    i = i + 1
                Wend
                i = i + 1
                Temp = frmSelectGoods.GCode & vbTab & RsTemp("品名") & vbTab & _
                        RsTemp("单位") & vbTab & s & vbTab & Str(Qty * RsTemp("含税进价")) & vbTab & Str(Qty * prc)
                grdDET.AddItem Temp
            Wend
        End If
        Unload frmSelectGoods

End Sub

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



Private Sub grdDET_BeforeColUpdate(ByVal ColIndex As Integer, ByVal OldValue As Variant, Cancel As Integer)
    If ColIndex = 0 Then
        sSQL = "SELECT 品名,单位 FROM 商品主档 WHERE 商品编码='" & Trim(grdDET.Columns(ColIndex).Text) & "'"   ' as a left join 分店商品信息 as b on a.商品编码=b.商品编码 WHERE a.商品编码='" & Trim(grdDET.Columns(ColIndex).Text) & "' and b.分店编码='" & Trim(cmbGroup.Text) & "'"
        Set RsTemp = Nothing
        RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
        If RsTemp.EOF Then
            MsgBox "该商品编码不存在!" & vbCrLf & "请检查输入是否正确或查询商品编码.", vbExclamation, "提示窗口"
            Cancel = 1
        Else
            grdDET.Columns("商品名称").Text = RsTemp("品名")
            grdDET.Columns("单位").Text = RsTemp("单位")
           ' grdDET.Columns("颜色").Text = RsTemp("颜色")
           ' grdDET.Columns("尺寸").Text = RsTemp("尺寸")
'            grdDET.Columns("单价").Value = RsTemp("配送价")
    
        sSQL = "SELECT 尺寸 FROM 商品信息 where 商品编码='" & Trim(grdDET.Columns("商品编码").Text) & "' group by 尺寸"
        Set RsTemp = Nothing
        RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
        grdDET.Columns("尺寸").RemoveAll
        While Not RsTemp.EOF
            grdDET.Columns("尺寸").AddItem RsTemp("尺寸")
            RsTemp.MoveNext
        Wend
        sSQL = "SELECT 颜色 FROM 商品信息 where 商品编码='" & Trim(grdDET.Columns("商品编码").Text) & "' group by 颜色 "
        Set RsTemp = Nothing
        RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
        grdDET.Columns("颜色").RemoveAll
        While Not RsTemp.EOF
            grdDET.Columns("颜色").AddItem RsTemp("颜色")
            RsTemp.MoveNext
        Wend
        
        sSQL = "SELECT 含税进价 as 进价 FROM LSJHD where 商品编码='" & Trim(grdDET.Columns("商品编码").Text) & "' group by 含税进价 "
        Set RsTemp = Nothing
        RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
        'grdDET.Columns("进价").RemoveAll
       ' While Not RsTemp.EOF
       '     grdDET.Columns("进价").AddItem RsTemp("进价")
       '     RsTemp.MoveNext
       ' Wend
        If Not RsTemp.EOF Then grdDET.Columns("单价").Value = (1 + JD / 100) * RsTemp("进价")
        Cancel = 0
        End If
    ElseIf ColIndex = 5 Or 6 Then
        grdDET.Columns("金额").Text = grdDET.Columns("单价").Value * grdDET.Columns("数量").Value
    End If

End Sub

Private Sub grdDET_KeyDown(KeyCode As Integer, Shift As Integer)
        If KeyCode = vbKeyDown Then grdDET.ComboDroppedDown = True
End Sub