⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmsaleproduct.frm

📁 VB礼品店销售管理系统 包括ACCESS数据库访问职工管理 账单管理
💻 FRM
📖 第 1 页 / 共 3 页
字号:
    '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 + -