frmchsale.frm

商品进销存软件

    If TextXS(i).Text = "" Then
        MsgBox "数据输入不完整，请确认数据输入完整", vbExclamation, "系统提示"
        TextXS(i).SetFocus
        Exit Sub
    End If
Next
'//////////判断库存/////////////////
Dim intSpNewCount As Integer '保存新输入的商品数量，用以判断库存
Dim intNeedCount As Integer
intSpNewCount = Val(TextXS(2).Text)
'**如果商品名改变，则需要的库存数量为输入的数量**
If strSaleName = Trim(Combo4.Text) Then
    If intSpNewCount > intSpOldCount Then
        intNeedCount = intSpNewCount - intSpOldCount '更新需要的库存量
    End If
Else
    intNeedCount = intSpNewCount
End If
Dim enough As Integer
enough = isEnough(Trim(Combo4.Text), intNeedCount)
If enough = 0 Then '判断库存是否足够
    MsgBox "该商品库存数量已经不够，请增加该商品数量", vbExclamation, "系统提示"
    Call cmdClear_Click
    Exit Sub
End If
'////////////删除旧记录///////////
Dim strDelsql As String
strDelsql = "delete from 销售表 where 销售编号='" & TextXS(0).Text & "'"
ExeSQL (strDelsql)
'****************添加新记录********************
Dim sqlsale As String

If TextXS(4).Text <> "" Then
sqlsale = "insert into 销售表(ID,销售编号,销售方式,商品编号,售价,数量,结账方式,数额,员工编号,用户编号,日期,备注) "
sqlsale = sqlsale & "values(" & intSaleId & ",'" & Trim(TextXS(0).Text) & "','" & Combo3.Text & "','" & spid(Combo4.Text) & "'," & Val(TextXS(1).Text) & "," & Val(TextXS(2).Text) & ",'" & Combo5.Text & "'," & Val(TextXS(3).Text) & ",'" & DTPickersale.Value & "','" & TextXS(4).Text & "')"
Else
sqlsale = "insert into 销售表(ID,销售编号,销售方式,商品编号,售价,数量,结账方式,数额,员工编号,用户编号,日期,备注) "
sqlsale = sqlsale & "values(" & intSaleId & ",'" & Trim(TextXS(0).Text) & "','" & Combo3.Text & "','" & spid(Combo4.Text) & "'," & Val(TextXS(1).Text) & "," & Val(TextXS(2).Text) & ",'" & Combo5.Text & "'," & Val(TextXS(3).Text) & ",'" & DTPickersale.Value & "','nothing')"
End If
ExeSQL (sqlsale)
Call subtractKC
MsgBox "销售记录登记成功", vbInformation, "系统提示"
Call cmdClear_Click
'errhander:
'MsgBox "系统错误，请联系管理员", vbCritical, "系统错误"

cmdInput.Enabled = True
cmdChange.Enabled = False
cmddel.Enabled = False
    Call loadXS(cmoxiaoshoubiaohao)
End Sub
Public Sub subtractKC() '销售后，减少库存商品数量
Dim rskc As ADODB.Recordset
Dim rskc2 As ADODB.Recordset
Dim strSqlkc As String
Dim intSpNewCount As Integer '保存新输入的商品数量，用以判断库存
Dim intNeedCount As Integer
Dim kc As Integer
intSpNewCount = Val(TextXS(2).Text)
If strSaleName = Trim(Combo4.Text) Then
        intNeedCount = intSpNewCount - intSpOldCount '更新需要的库存量
    sqlkc = "select 数量 from 库存表 where 商品名称='" & Trim(Combo4.Text) & "'"
    If intNeedCount <> 0 Then
        Set rskc = ExeSQL(sqlkc)
        rskc.Fields(0) = Val(rskc.Fields(0)) - intNeedCount
        rskc.Update
    Else
        Exit Sub
    End If
Else
    '****更新更换了物品类型的库存数量*****
    sqlkc = "select 数量 from 库存表 where 商品名称='" & Trim(Combo4.Text) & "'"
    Set rskc = ExeSQL(sqlkc)
    rskc.Fields(0) = Val(rskc.Fields(0)) - intSpNewCount
    rskc.Update
    '****恢复原物品类型的库存
    sqlkc = "select 数量 from 库存表 where 商品名称='" & strSaleName & "'"
    Set rskc2 = ExeSQL(sqlkc)
    rskc2.Fields(0) = Val(rskc2.Fields(0)) + intSpOldCount
    rskc2.Update
    rskc2.Close
    Set rskc2 = Nothing
End If
rskc.Close
Set rskc = Nothing
End Sub

Private Sub cmddel_Click()
Dim sql As String
Dim strSaleId As String
strSaleId = Trim(Me.cmoxiaoshoubiaohao.Text)
If strSaleId = "" Then
    MsgBox "销售编号输入有误，请重输！", vbOKOnly + vbExclamation, "系统提示"
    Exit Sub
End If
sql = "delete from 销售表 where 销售编号='" & strSaleId & "'"
ExeSQL (sql)
MsgBox "销售记录删除成功！", vbOKOnly + vbInformation, "系统提示"
rsSale.Close
Set rsSale = Nothing
cmdInput.Enabled = True
cmddel.Enabled = False
cmdChange.Enabled = False
Exit Sub
errorhandle:
If Err.Number = 91 Then
Resume Next
End If
    Call loadXS(cmoxiaoshoubiaohao)
End Sub

Private Sub cmdInput_Click()
Dim strSaleId As String
Dim strAql As String
strSaleId = Trim(cmoxiaoshoubiaohao.Text)
If strSaleId = "" Then
    MsgBox "请输入销售编号!", vbOKOnly + vbInformation, "系统提示"
    Exit Sub
Else
    sql = "select  销售表.ID as 流水号,销售表.销售编号 as 销售编号,销售表.销售方式 as 销售方式,商品表.商品名称 as 商品名称,"
    sql = sql & "销售表.售价 as 售价,销售表.数量 as 数量,销售表.结账方式 as 结账方式,销售表.数额 as 数额 ,销售表.备注 as 备注"
    sql = sql & ",销售表.日期 as 日期"
    sql = sql & "  from 销售表,商品表 where 销售编号='" & strSaleId & "' and 销售表.商品编号=商品表.商品编号"
    Set rsSale = ExeSQL(sql)
    If rsSale.EOF Then
        MsgBox "没有这条记录，请重新查询", vbInformation + vbOKOnly, "系统提示"
        rsSale.Close
        Set rsSale = Nothing
        Exit Sub
    Else
        intSaleId = rsSale("流水号")
        Combo3.Text = rsSale("销售方式")
        Combo4.Text = rsSale("商品名称")
        Combo5.Text = rsSale("结账方式")
        TextXS(0).Text = rsSale("销售编号")
        TextXS(1).Text = rsSale("售价")
        TextXS(2).Text = rsSale("数量")
        TextXS(3).Text = rsSale("数额")
        TextXS(4).Text = rsSale("备注")
        DTPickersale.Value = Format(rsSale("日期"), "yyyy-mm-dd hh:mm:ss")
    End If
End If
intSpOldCount = rsSale("数量")
strSaleName = Trim(Combo4.Text)
cmdChange.Enabled = True
cmddel.Enabled = True
cmdInput.Enabled = False
End Sub

Private Sub Combo3_Change()
Call Combo4_Click
End Sub

Private Sub Combo3_Click()
Dim saleway As String
Dim spname As String
saleway = Trim(Combo3.Text)
spname = Trim(Combo4.Text)
TextXS(1).Text = spjg(saleway, spname)
End Sub

Private Sub Combo4_Click()
Dim saleway As String
Dim spname As String
saleway = Trim(Combo3.Text)
spname = Trim(Combo4.Text)
TextXS(1).Text = spjg(saleway, spname)
End Sub

Private Sub Combo5_Change()
Call TextXS_Change(2)
End Sub

Private Sub Form_Load()
    Call loadSP(Combo4)
    Call loadXS(cmoxiaoshoubiaohao)
    DTPickersale = Now()
    cmdChange.Enabled = False
    cmddel.Enabled = False
End Sub
Private Sub loadSP(combo As ComboBox) '加载商品名称的过程
On Error GoTo errorhandle
Dim rssp As ADODB.Recordset
Dim sqlsp As String
sqlsp = "select 商品名称 from 商品表"
Set rssp = ExeSQL(sqlsp)
combo.Clear
Do While Not rssp.EOF
    combo.AddItem (rssp.Fields(0))
    rssp.MoveNext
Loop
combo.ListIndex = 0
rssp.Close
Set rssp = Nothing
Exit Sub
errorhandle:
If Err.Number = 380 Then
Resume Next
End If
End Sub
Private Sub loadYG(combo As ComboBox) '加载员工名称的过程
On Error GoTo errorhandle
Dim rsyg As ADODB.Recordset
Dim sqlyg As String
sqlyg = "select 姓名 from 员工表"
Set rsyg = ExeSQL(sqlyg)
combo.Clear
Do While Not rsyg.EOF
    combo.AddItem (rsyg.Fields(0))
    rsyg.MoveNext
Loop
combo.ListIndex = 0
rsyg.Close
Set rsyg = Nothing
Exit Sub
errorhandle:
If Err.Number = 380 Then
Resume Next
End If
End Sub
Private Sub loadKF(combo As ComboBox) '加载客户名称的过程
On Error GoTo errorhandle
Dim rsKF As ADODB.Recordset
Dim sqlKF As String
sqlKF = "select 姓名 from 客户表"
Set rsKF = ExeSQL(sqlKF)
combo.Clear
Do While Not rsKF.EOF
    combo.AddItem (rsKF.Fields(0))
    rsKF.MoveNext
Loop
combo.ListIndex = 0
rsKF.Close
Set rsKF = Nothing
Exit Sub
errorhandle:
If Err.Number = 380 Then
Resume Next
End If
End Sub



Private Sub TextXS_Change(Index As Integer)
If Combo5.Text = "现金" Then
    TextXS(3).Text = Val(TextXS(1).Text) * Val(TextXS(2).Text)
Else
    TextXS(3).Text = Val(TextXS(2).Text)
End If

End Sub
Public Function isEnough(ByVal spname As String, Optional ByVal num As Integer) As Integer '判断库存中商品数量是否足够的函数
Dim rskc As ADODB.Recordset
Dim sqlkc As String
sqlkc = "select 数量 from 库存表 where 商品名称='" & spname & "'"
Set rskc = ExeSQL(sqlkc)
If num = 0 Then
    num = 0
End If
If Val(rskc.Fields(0)) > num Then '当小于等于零时，返回0，库存不足
    isEnough = 1
Else
    isEnough = 0
End If
rskc.Close
Set rskc = Nothing
End Function
Private Sub cmdClear_Click()
TextXS(2).Text = ""
TextXS(2).SetFocus
End Sub
 Private Sub loadXS(combo As ComboBox) '加载销售编号的过程
Dim rsXS As ADODB.Recordset
Dim sqlXS As String
sqlXS = "select * from 销售表"
Set rsXS = ExeSQL(sqlXS)
combo.Clear
Do While Not rsXS.EOF
    combo.AddItem (rsXS.Fields("销售编号"))
    rsXS.MoveNext
Loop
combo.ListIndex = 0
rsXS.Close
Set rsXS = Nothing
Exit Sub
End Sub