📄 frmsaleproduct.frm
字号:
'End If
'再次判断是否有此产品编号
Dim rs As Recordset
productid = Trim(cmbProductId.Text)
sqlstring = "select productname,treesort,picture,lowestprice,JinhuoPrice,remainNumber from product where productid='" & productid & "'"
dbs.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbFile & ";Persist Security Info=False"
Set rs = dbs.Execute(sqlstring)
If Not rs.BOF Then
txtProductname.Text = rs.Fields("productname")
imgProduct.Picture = LoadPicture(rs.Fields("picture"))
txtLeft.Text = rs.Fields("remainNumber")
inprice = rs.Fields("JinhuoPrice")
txtTreeSort.Text = rs.Fields("treeSort")
Else
MsgBox "没有找到该产品的相关库存信息,请检查产品编号是否存在!", 48, "信息提示"
cmbProductId.SetFocus
rs.Close
Set rs = Nothing
dbs.Close
Exit Sub
End If
rs.Close
'判断是否有此客户
If cmbCustomerID <> "" Then
sqlstring = "select id from customer where id=" & Val(cmbCustomerID)
Set rs = Nothing
Set rs = dbs.Execute(sqlstring)
If rs.BOF Then
MsgBox "没有找到该客户的相关信息,请先填加该客户信息!", 48, "信息提示"
cmbCustomerID.SetFocus
rs.Close
Set rs = Nothing
dbs.Close
Exit Sub
End If
rs.Close
Set rs = Nothing
dbs.Close
End If
If IsNumeric(txtSalesPrice) = False Or Val(txtSalesPrice) <= 0 Then
MsgBox "销售价格要为数字并且大于0,请重填销售价格!", 48, "信息提示"
txtSalesPrice.SetFocus
Exit Sub
End If
If IsNumeric(txtNumber) = False Or Val(txtNumber) <= 0 Or (Val(txtNumber) - (Fix(Val(txtNumber))) <> 0) Then
MsgBox "销售数量要为数字并且为大于0的整数,请重填销售数量!", 48, "信息提示"
txtNumber.SetFocus
Exit Sub
End If
If Val(txtNumber) - Val(txtLeft) > 0 Then
MsgBox "销售数量不能大于库存数量,请重填销售数量!", 48, "信息提示"
txtNumber.SetFocus
Exit Sub
End If
lirun = (CSng((txtSalesPrice.Text)) - inprice) * CInt(txtNumber.Text)
If cmbCustomerID <> "" Then
custid = Val(cmbCustomerID)
sqlstring = "insert into tabSales(productid,productname,salesprice,shuliang,customerid,salespersonid,InPrice,lirun,treesort) values('" & cmbProductId.Text & "','" & txtProductname.Text & _
"'," & txtSalesPrice.Text & "," & txtNumber.Text & "," & custid & ",'" & _
txtSalesID & "'," & inprice & "," & lirun & ",'" & txtTreeSort & "')"
Else
custid = Val(0)
sqlstring = "insert into tabSales(productid,productname,salesprice,shuliang,salespersonid,InPrice,lirun,treesort,customerid) values('" & cmbProductId.Text & "','" & txtProductname.Text & _
"'," & txtSalesPrice.Text & "," & txtNumber.Text & ",'" & _
txtSalesID & "'," & inprice & "," & lirun & ",'" & txtTreeSort & "'," & Val(custid) & ")"
dbs.Close
End If
dbs.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbFile & ";Persist Security Info=False"
dbs.Execute sqlstring
dbs.Close
sqlstring = "update product set remainNumber=(remainNumber-" & txtNumber.Text & ") where productid='" & cmbProductId.Text & "'"
dbs.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbFile & ";Persist Security Info=False"
dbs.Execute sqlstring
dbs.Close
Adodc1.Refresh
DataGrid1.Refresh
MsgBox "该产品成功卖出!", 48, "信息提示"
'插入数据到报表表中
dbs.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbFile & ";Persist Security Info=False"
If custid <> 0 Then
sqlstring = "select * from Customer where id=" & cmbCustomerID
Set rs = dbs.Execute(sqlstring)
cstName = rs.Fields("name")
cstPhone = rs.Fields("phone")
cstEmail = rs.Fields("email")
cstAddress = rs.Fields("address")
rs.Close
Set rs = Nothing
Else
cstName = ""
cstPhone = ""
cstEmail = ""
cstAddress = ""
End If
sqlstring = "delete from tabForPrint"
dbs.Execute sqlstring
totalprice = Val(txtNumber) * Val(txtSalesPrice)
sqlstring = "insert into tabForPrint(bh,seqno,productId,productName,TreeSort,shuliang,salesprice,totalprice) values(" & _
"1,1,'" & cmbProductId & "','" & txtProductname & "','" & txtTreeSort & "'," & txtNumber & "," & txtSalesPrice & "," & totalprice & ")"
dbs.Execute sqlstring
sqlstring = "insert into tabForPrint(bh,seqno,productId,productName,TreeSort,shuliang,salesprice,totalprice) values(" & _
"2,1,'" & cmbProductId & "','" & txtProductname & "','" & txtTreeSort & "'," & txtNumber & "," & txtSalesPrice & "," & totalprice & ")"
dbs.Execute sqlstring
dbs.Close
iSelect = MsgBox("是否打印此销售信息?", 36, "信息提示")
If iSelect = 6 Then '打印
Call cmdPrint_Click
End If
cmdClear_Click
Exit Sub
errhandle1:
If Err.Number = 3705 Then
dbs.Close
End If
MsgBox "有错误发生,该操作失败!", 48, "信息提示"
End Sub
Private Sub cmdAll_Click()
sqlstring = "select a.lsh,a.productid,a.productname,a.salesprice,a.shuliang,a.saledate,a.customerid,a.salespersonid,a.treesort,b.name,b.phone from tabsales a,customer b where a.customerid=b.id order by a.saledate desc"
Adodc1.RecordSource = sqlstring
Adodc1.Refresh
End Sub
Sub cmdClear_Click()
cmbCustomerID = ""
cmbProductId = ""
DTPDate = Date
DTPTime = Time
imgProduct.Picture = LoadPicture("")
txtLeft = ""
txtNumber = ""
txtProductname = ""
txtSalesID = userid
txtSalesPrice = ""
txtTreeSort = ""
End Sub
Private Sub cmdDel_Click()
On Error GoTo errhandle
If lsh = 0 Then
MsgBox "从下面的销售流水中选择相应记录!", 48, "信息提示"
Exit Sub
End If
dbs.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbFile & ";Persist Security Info=False"
sqlstring = "select shuliang,productid from tabsales where lsh=" & lsh
Dim rs As Recordset
Set rs = dbs.Execute(sqlstring)
If Not rs.BOF Then
sqlstring1 = "update product set remainnumber=remainnumber+" & rs.Fields("shuliang") & " where productid='" & rs.Fields("productid") & "'"
dbs.Execute sqlstring1
End If
rs.Close
sqlstring = "delete from tabsales where lsh=" & lsh
'dbs.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbFile & ";Persist Security Info=False"
dbs.Execute sqlstring
Set rs = Nothing
dbs.Close
Adodc1.Refresh
Exit Sub
errhandle:
If Err.Number = 3705 Then
dbs.Close
End If
MsgBox "删除客户记录时有错误发生,错误编号为:" & Err.Number, 48, "信息提示"
End Sub
Private Sub cmdPrint_Click()
On Error GoTo errhandle1
'If prtFrm = True Then
'Unload DataReport1
' Unload DataEnvironment
'End If
DataEnvironment1.Connection1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbFile & " ;Persist Security Info=False"
sPrtCust = MsgBox("是否需要打印客户信息?", 36, "信息提示")
If sPrtCust = 6 Then 'yes
DataReport1.Sections(3).Controls(4).Caption = cstName 'name
DataReport1.Sections(3).Controls(6).Caption = cstAddress 'address
DataReport1.Sections(3).Controls(8).Caption = cstPhone 'phone
DataReport1.Sections(3).Controls(10).Caption = cstEmail 'email
Else
DataReport1.Sections(3).Controls(4).Caption = " " 'name
DataReport1.Sections(3).Controls(6).Caption = " " 'address
DataReport1.Sections(3).Controls(8).Caption = " " 'phone
DataReport1.Sections(3).Controls(10).Caption = " " 'email
End If
DataReport1.Show
'DataEnvironment1.Connection1.Close
Exit Sub
errhandle1:
'MsgBox "有错误发生,数据连接失败,请重新再试!", 48, "信息提示"
'Unload DataEnvironment1
'If Err.Number = 3705 Then
'DataEnvironment1.Connection1.Close
'DataEnvironment1.Connection1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbFile & " ;Persist Security Info=False"
Unload DataEnvironment1
DataEnvironment1.Connection1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbFile & " ;Persist Security Info=False"
sPrtCust = MsgBox("是否需要打印客户信息?", 36, "信息提示")
If sPrtCust = 6 Then 'yes
DataReport1.Sections(3).Controls(4).Caption = cstName 'name
DataReport1.Sections(3).Controls(6).Caption = cstAddress 'address
DataReport1.Sections(3).Controls(8).Caption = cstPhone 'phone
DataReport1.Sections(3).Controls(10).Caption = cstEmail 'email
Else
DataReport1.Sections(3).Controls(4).Caption = " " 'name
DataReport1.Sections(3).Controls(6).Caption = " " 'address
DataReport1.Sections(3).Controls(8).Caption = " " 'phone
DataReport1.Sections(3).Controls(10).Caption = " " 'email
End If
DataReport1.Show
'End If
End Sub
Private Sub cmdQuery_Click()
frminquireProduct.Show 1
End Sub
Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
On Error GoTo errhandle1
cmbProductId = Adodc1.Recordset.Fields("productid")
txtProductname = Adodc1.Recordset.Fields("productname")
txtTreeSort = Adodc1.Recordset.Fields("treesort")
s = Split(Adodc1.Recordset.Fields("saledate"), " ")
DTPDate.Value = s(0)
txtSalesPrice = Adodc1.Recordset.Fields("salesprice")
txtNumber = Adodc1.Recordset.Fields("shuliang")
cmbCustomerID = Adodc1.Recordset.Fields("customerid")
txtSalesID = Adodc1.Recordset.Fields("salespersonid")
lsh = Adodc1.Recordset.Fields("lsh")
Dim rs As Recordset
sqlstring = "select picture from product where productid='" & cmbProductId & "'"
dbs.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbFile & ";Persist Security Info=False"
Set rs = dbs.Execute(sqlstring)
If Not rs.BOF Then
imgProduct.Picture = LoadPicture(rs.Fields("picture"))
End If
rs.Close
Set rs = Nothing
dbs.Close
Exit Sub
errhandle1:
If Err.Number = 3705 Then
dbs.Close
End If
MsgBox "有错误发生,该操作失败!", 48, "信息提示"
End Sub
Private Sub Form_Load()
On Error GoTo errhandle1
Dim rs As ADODB.Recordset
sqlstring = "select productid from product order by productId"
dbs.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbFile & ";Persist Security Info=False"
Set rs = dbs.Execute(sqlstring)
rs.MoveFirst
While Not rs.EOF
cmbProductId.AddItem (rs.Fields("productid"))
rs.MoveNext
Wend
rs.Close
DTPDate = Date
DTPTime = Time
Set rs = Nothing
sqlstring = "select id from customer order by id desc"
Set rs = dbs.Execute(sqlstring)
rs.MoveFirst
While Not rs.EOF
cmbCustomerID.AddItem (rs.Fields("id"))
rs.MoveNext
Wend
rs.Close
Set rs = Nothing
txtSalesID.Text = userid
dbs.Close
sqlstring = "select a.lsh,a.productid,a.productname,a.salesprice,a.shuliang,a.saledate,a.customerid,a.salespersonid,a.treesort,b.name,b.phone from tabsales a,customer b where a.customerid=b.id order by a.saledate desc"
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbFile & ";Persist Security Info=False"
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = sqlstring
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
SaleProductFlag = True '产品销售
Exit Sub
errhandle1:
If Err.Number = 3705 Then
dbs.Close
End If
MsgBox "有错误发生,加载数据失败!", 48, "信息提示"
End Sub
Private Sub Form_Terminate()
SaleProductFlag = False
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -