frm

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

            ",'" & grdDET.Columns(1).Text & "'" & _
            ",'" & grdDET.Columns(2).Text & "'" & _
            "," & grdDET.Columns(3).Text & _
            "," & grdDET.Columns(4).Text & _
            "," & grdDET.Columns(5).Text & ")"
        Cmd.ActiveConnection = Conn
        Cmd.CommandText = sSQL
        Cmd.Execute
        grdDET.MoveNext
    Next N
    SaveTable = True
    Exit Function
SaveErr:
    MsgBox "保存销售数据时发生错误!!", vbExclamation, "错误窗口"
    SaveTable = False
End Function

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 cmdPrint_Click()
    grdDET.PrintData ssPrintAllRows, True, False
End Sub

Private Sub cmdToolAdd_Click()
    cmbGroup.Text = ""
    grdDET.RemoveAll
    cmdToolCommit.Enabled = True
    cmdToolSave.Enabled = True
    cmdToolDelete.Enabled = True
End Sub

Private Sub cmdToolCommit_Click()
    On Error GoTo CommitErr
    
    Dim Rec As New ADODB.Recordset
    Dim Temp2, GoodsNum

    If cmbGroup.Text = "" Then
        MsgBox "请先选择销售部门!!", vbInformation, "提示窗口"
        Exit Sub
    End If
    If grdDET.Rows = 0 Then
        MsgBox "无销售数据!!", vbInformation, "提示窗口"
        Exit Sub
    End If

    If MsgBox("确认之后将不能再修改!!继续吗？", vbQuestion + vbYesNo, "提示窗口") = vbNo Then Exit Sub

    Conn.BeginTrans

    sSQL = "DELETE 分店销售 WHERE " & _
            " 分店编码='" & cmbGroup.Text & "'" & _
            " AND 销售日期='" & Format(dtpDate.Value, "YYYY-MM-DD") & "'"
    Cmd.ActiveConnection = Conn
    Cmd.CommandText = sSQL
    Cmd.Execute

    If Not SaveTable() Then
        MsgBox "确认失败!!,请检查数据是否存在错误!!", vbExclamation, "提示窗口"
        Conn.RollbackTrans
        Exit Sub
    End If
    
    sSQL = "INSERT INTO POS销售明细(操作员,分店编码,商品编码,数量,单价,金额,日期)" & _
            " SELECT 操作员,分店编码,商品编码,数量,零售价,零售金额,销售日期 FROM 分店销售 " & _
            " WHERE 销售日期='" & Format(dtpDate.Value, "YYYY-MM-DD") & "'" & _
            " AND 分店编码='" & cmbGroup.Text & "'"
    Cmd.ActiveConnection = Conn
    Cmd.CommandText = sSQL
    Cmd.Execute
    
    '汇总标志='P'
    sSQL = "    UPDATE POS销售明细 SET 汇总标志='P'" & _
            " WHERE 日期='" & Format(dtpDate.Value, "YYYY-MM-DD") & "'" & _
            " AND 分店编码='" & cmbGroup.Text & "'"
    Cmd.ActiveConnection = Conn
    Cmd.CommandText = sSQL
    Cmd.Execute

    If Not OperSale Then
        MsgBox "确认失败!!,请检查数据是否存在错误!!", vbExclamation, "提示窗口"
        Conn.RollbackTrans
        Exit Sub
    End If
    
    sSQL = "UPDATE 分店销售 SET 确认状态=1 WHERE " & _
            " 分店编码='" & cmbGroup.Text & "'" & _
            " AND 销售日期='" & Format(dtpDate.Value, "YYYY-MM-DD") & "'"
    Cmd.ActiveConnection = Conn
    Cmd.CommandText = sSQL
    Cmd.Execute

    Conn.CommitTrans
    cmdToolCommit.Enabled = False
    cmdToolDelete.Enabled = False
    cmdToolSave.Enabled = False
    
   
    Exit Sub
CommitErr:
    MsgBox "确认错误!!，请检查录入数据是否存在错误!!", vbExclamation, "错误窗口"
    Conn.RollbackTrans
End Sub

Private Sub cmdToolDelete_Click()
    On Error GoTo DeleteErr
    If cmbGroup.Text = "" Then
        MsgBox "请先选择销售部门!!", vbInformation, "提示窗口"
        Exit Sub
    End If
    Temp = "分店编码：" & cmbGroup.Text & vbCrLf
    Temp = "销售日期：" & dtpDate.Value
    If MsgBox("确定要删除以下销售信息吗？" & Temp, vbQuestion + vbYesNo, "提示窗口") = vbNo Then Exit Sub
    sSQL = "DELETE 分店销售 WHERE " & _
            " 分店编码='" & cmbGroup.Text & "'" & _
            " AND 销售日期='" & Format(dtpDate.Value, "YYYY-MM-DD") & "'"
    Cmd.ActiveConnection = Conn
    Cmd.CommandText = sSQL
    Cmd.Execute
    grdDET.RemoveAll
    Exit Sub
DeleteErr:
    MsgBox "删除错误!!", vbExclamation, "错误窗口"
End Sub

Private Sub cmdToolExit_Click()
    Unload Me
End Sub

Private Sub cmdToolQuery_Click()
    On Error Resume Next
    If cmbGroup.Text = "" Then
        MsgBox "请先选择销售部门!!", vbInformation, "提示窗口"
        Exit Sub
    End If
    sSQL = "SELECT * FROM 分店销售 WHERE " & _
            " 分店编码='" & cmbGroup.Text & "'" & _
            " AND 销售日期='" & Format(dtpDate.Value, "YYYY-MM-DD") & "'"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    If RsTemp.EOF Then
        MsgBox "未发现匹配记录!!", vbInformation, "提示窗口"
        grdDET.RemoveAll
        Exit Sub
    End If
    If RsTemp("确认状态") Then
        cmdToolCommit.Enabled = False
        cmdToolDelete.Enabled = False
        cmdToolSave.Enabled = False
    Else
        cmdToolCommit.Enabled = True
        cmdToolDelete.Enabled = True
        cmdToolSave.Enabled = True
    End If
    grdDET.RemoveAll
    While Not RsTemp.EOF
        grdDET.AddItem 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
    If txtIptno.Text = "" Then
        MsgBox "请先填入操作员!!", vbInformation, "提示窗口"
        Exit Sub
    End If
    
    sSQL = "SELECT * FROM 分店销售 WHERE " & _
            " 分店编码='" & cmbGroup.Text & "'" & _
            " AND 销售日期='" & Format(dtpDate.Value, "YYYY-MM-DD") & "'"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    If Not RsTemp.EOF Then
        If RsTemp("确认状态") Then
            MsgBox "该销售数据已经存在!", vbInformation, "提示窗口"
            Exit Sub
        Else
            If MsgBox("该销售数据已经存在!覆盖吗？", vbQuestion + vbYesNo, "提示窗口") = vbNo Then Exit Sub
        End If
    End If
    Conn.BeginTrans
    sSQL = "DELETE 分店销售 WHERE " & _
        " 分店编码='" & cmbGroup.Text & "'" & _
        " AND 销售日期='" & Format(dtpDate.Value, "YYYY-MM-DD") & "'"
    Cmd.ActiveConnection = Conn
    Cmd.CommandText = sSQL
    Cmd.Execute
    If Not SaveTable() Then
        MsgBox "保存失败!!，请检查数据是否存在错误!!", vbExclamation, "错误窗口"
        Conn.RollbackTrans
        Exit Sub
    End If
    Conn.CommitTrans
    cmdToolCommit.Enabled = True
    cmdToolDelete.Enabled = True
End Sub


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

Private Sub Form_Load()
    Call SetFormToCenter(Me)
    txtIptno.SetConn Conn
    txtIptno.TableName = ClerkInfo
    txtIptno.CodeField = ClerkCode
    txtIptno.NameField = ClerkName
    txtIptno.Text = UserCode
    dtpDate.Value = Now
End Sub


Private Sub grdDET_AfterDelete(RtnDispErrMsg As Integer)
    Call CalTotalDelete
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 商品编码='" & grdDET.Columns(ColIndex).Text & "'"
        Set RsTemp = Nothing
        Set RsTemp = OpenRS(sSQL)
        If RsTemp.EOF Then
            MsgBox "该商品编码不存在!" & vbCrLf & "请检查输入是否正确或查询商品编码.", vbExclamation, "提示窗口"
            Cancel = 1
        Else
            grdDET.Columns(1).Text = RsTemp("品名")
            grdDET.Columns(2).Text = RsTemp("单位")
            grdDET.Columns(4).Value = RsTemp("零售价")
            Cancel = 0
        End If
        sSQL = "SELECT SUM(数量) AS 数量 FROM 分店库存 WHERE 商品编码='" & grdDET.Columns(ColIndex).Text & "'" & _
                " AND 分店编码='" & Trim(cmbGroup.Text) & "' group by 分店编码,商品编码 "
        Set RsTemp = Nothing
        Set RsTemp = OpenRS(sSQL)
        If Not RsTemp.EOF Then
            grdDET.Columns("数量").Value = RsTemp("数量")
        Else
            grdDET.Columns("数量").Value = 0
        End If
        
        sSQL = "SELECT top 1 配送日期,分店编码,商品编码,零售价 FROM 商品配送单 WHERE 商品编码='" & grdDET.Columns(ColIndex).Text & "'" & _
                " AND 分店编码='" & Trim(cmbGroup.Text) & "' order by 配送日期 desc"
        Set RsTemp = Nothing
        Set RsTemp = OpenRS(sSQL)
        If Not RsTemp.EOF Then
            grdDET.Columns("零售价").Value = RsTemp("零售价")
        Else
            grdDET.Columns("零售价").Value = 0
        End If
        
        
    ElseIf ColIndex = 4 Or ColIndex = 3 Then
        grdDET.Columns(5).Text = grdDET.Columns(3).Value * grdDET.Columns(4).Value
    End If

End Sub

Private Sub CalTotalDelete()
    txtSum.Text = ""
    For I = 0 To grdDET.Rows - 1
        txtSum.Text = CStr(Val(txtSum.Text) + grdDET.Columns(5).CellValue(I))
    Next I
    txtSum.Text = Format(txtSum.Text, DecNum)
End Sub

Private Sub grdDET_RowColChange(ByVal LastRow As Variant, ByVal LastCol As Integer)
    Call CalTotalDelete
End Sub

Private Sub grdDET_BeforeRowColChange(Cancel As Integer)
    Call CalTotalDelete
End Sub