frmretreat.frm

数据库销售系统

VERSION 5.00
Begin VB.Form frmRetreat 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "退货登记"
   ClientHeight    =   4770
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6525
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   4770
   ScaleWidth      =   6525
   Begin VB.CommandButton cmdReset 
      Caption         =   "清空重填"
      Height          =   375
      Left            =   3960
      TabIndex        =   12
      Top             =   4080
      Width           =   1455
   End
   Begin VB.CommandButton cmdRetreat 
      Caption         =   "退      货"
      Height          =   375
      Left            =   1320
      TabIndex        =   11
      Top             =   4080
      Width           =   1455
   End
   Begin VB.TextBox txtQuantity 
      Height          =   375
      Left            =   4560
      TabIndex        =   5
      Top             =   1920
      Width           =   1575
   End
   Begin VB.TextBox txtPrice 
      Height          =   375
      Left            =   1440
      TabIndex        =   4
      Top             =   1920
      Width           =   1455
   End
   Begin VB.TextBox txtType 
      Height          =   375
      Left            =   4560
      TabIndex        =   3
      Top             =   1080
      Width           =   1575
   End
   Begin VB.TextBox txtFc 
      Height          =   375
      Left            =   1440
      TabIndex        =   2
      Top             =   1080
      Width           =   1455
   End
   Begin VB.TextBox txtName 
      Height          =   375
      Left            =   4560
      TabIndex        =   1
      Top             =   240
      Width           =   1575
   End
   Begin VB.TextBox txtGoodsNo 
      Enabled         =   0   'False
      Height          =   375
      Left            =   1440
      TabIndex        =   0
      Text            =   "编号自动添加"
      Top             =   240
      Width           =   1455
   End
   Begin VB.TextBox txtem 
      Height          =   375
      Left            =   1440
      TabIndex        =   9
      Top             =   3480
      Width           =   1455
   End
   Begin VB.TextBox txtyear 
      Height          =   375
      Left            =   1440
      TabIndex        =   6
      Top             =   2760
      Width           =   615
   End
   Begin VB.TextBox txtmon 
      Height          =   375
      Left            =   2640
      TabIndex        =   7
      Top             =   2760
      Width           =   615
   End
   Begin VB.TextBox txtday 
      Height          =   375
      Left            =   3960
      TabIndex        =   8
      Top             =   2760
      Width           =   615
   End
   Begin VB.TextBox txtmoney 
      Height          =   375
      Left            =   4560
      TabIndex        =   10
      Top             =   3480
      Width           =   1575
   End
   Begin VB.Label lblretreattime 
      Caption         =   "退货日期："
      Height          =   375
      Left            =   360
      TabIndex        =   24
      Top             =   2880
      Width           =   975
   End
   Begin VB.Label lblquantity 
      Caption         =   "数量："
      Height          =   255
      Left            =   3480
      TabIndex        =   23
      Top             =   1920
      Width           =   735
   End
   Begin VB.Label lblprice 
      Caption         =   "单价："
      Height          =   255
      Left            =   360
      TabIndex        =   22
      Top             =   2040
      Width           =   735
   End
   Begin VB.Label lbltype 
      Caption         =   "型号："
      Height          =   375
      Left            =   3480
      TabIndex        =   21
      Top             =   1200
      Width           =   735
   End
   Begin VB.Label lblfcname 
      Caption         =   "生产厂商："
      Height          =   375
      Left            =   360
      TabIndex        =   20
      Top             =   1200
      Width           =   975
   End
   Begin VB.Label lblgoodsname 
      Caption         =   "商品名称："
      Height          =   255
      Left            =   3480
      TabIndex        =   19
      Top             =   360
      Width           =   975
   End
   Begin VB.Label lblretreatno 
      Caption         =   "退货编号："
      Height          =   375
      Left            =   360
      TabIndex        =   18
      Top             =   360
      Width           =   975
   End
   Begin VB.Label lblem 
      Caption         =   "业务员编号："
      Height          =   255
      Left            =   360
      TabIndex        =   17
      Top             =   3600
      Width           =   1095
   End
   Begin VB.Label Label1 
      Caption         =   "年"
      Height          =   255
      Left            =   2280
      TabIndex        =   16
      Top             =   2880
      Width           =   255
   End
   Begin VB.Label Label2 
      Caption         =   "月"
      Height          =   255
      Left            =   3480
      TabIndex        =   15
      Top             =   2880
      Width           =   375
   End
   Begin VB.Label Label3 
      Caption         =   "日"
      Height          =   375
      Left            =   4800
      TabIndex        =   14
      Top             =   2880
      Width           =   375
   End
   Begin VB.Label Label4 
      Caption         =   "退货总金额："
      Height          =   255
      Left            =   3480
      TabIndex        =   13
      Top             =   3600
      Width           =   1095
   End
End
Attribute VB_Name = "frmRetreat"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

   Dim rs_back As New ADODB.Recordset
   Dim rs_check As New ADODB.Recordset
   Dim rs_buy As New ADODB.Recordset
  
Private Sub cmdReset_Click()
   txtName.Text = ""
   txtFc.Text = ""
   txtType.Text = ""
   txtPrice.Text = ""
   txtQuantity.Text = ""
   txtyear.Text = ""
   txtmon.Text = ""
   txtday.Text = ""
   txtem.Text = ""
   txtmoney.Text = ""
End Sub

Private Sub cmdRetreat_Click()
   '需要进行三次数据库操作，加入退货表，加入现存商品表，从销售表中减去
    
   txtGoodsNo.Enabled = False
   If txtFc.Text = "" Then
       MsgBox "请填写厂商名称！", vbOKOnly + vbInformation, "注意"
       txtFc.SetFocus
       Exit Sub
    ElseIf txtName.Text = "" Then
       MsgBox "请填写商品名称！", vbOKOnly + vbInformation, "注意"
       txtName.SetFocus
       Exit Sub
    ElseIf txtType.Text = "" Then
       MsgBox "请填写商品型号！", vbOKOnly + vbInformation, "注意"
       txtType.SetFocus
       Exit Sub
    ElseIf txtPrice.Text = "" Then
       MsgBox "请填写商品价格！", vbOKOnly + vbInformation, "注意"
       txtPrice.SetFocus
       Exit Sub
    ElseIf txtQuantity.Text = "" Then
       MsgBox "请填写商品数量！", vbOKOnly + vbInformation, "注意"
       txtQuantity.SetFocus
       Exit Sub
    ElseIf txtyear.Text = "" Then
       MsgBox "请填写退货年份！", vbOKOnly + vbInformation, "注意"
       txtyear.SetFocus
       Exit Sub
    ElseIf txtmon.Text = "" Then
       MsgBox "请填写退货月份！", vbOKOnly + vbInformation, "注意"
       txtmon.SetFocus
       Exit Sub
    ElseIf txtday.Text = "" Then
       MsgBox "请填写退货日！", vbOKOnly + vbInformation, "注意"
       txtday.SetFocus
       Exit Sub
    ElseIf txtem.Text = "" Then
       MsgBox "请填写业务员姓名！", vbOKOnly + vbInformation, "注意"
       txtem.SetFocus
       Exit Sub
    ElseIf txtmoney.Text = "" Then
       MsgBox "请填写退货总金额！", vbOKOnly + vbInformation, "注意"
       txtmoney.SetFocus
       Exit Sub
    End If
    Dim sqlcheck As String
    sqlcheck = "select * from sell where 商品名='" & txtName.Text & _
   "'and 生产厂商='" & txtFc.Text & "'and 型号='" & txtType.Text & "'"
   rs_check.CursorLocation = adUseClient
   rs_check.Open sqlcheck, conn, adOpenKeyset, adLockPessimistic
   If rs_check.EOF = True Then
      MsgBox "对不起，没有销售此商品型号！无法退货！", vbOKOnly + vbInformation, "注意"
      rs_check.Close
      Exit Sub
   ElseIf (rs_check.Fields(5)) < Val(txtQuantity.Text) Then    '使用val 函数把text中的字符转变为数字
      MsgBox "此型号商品退货量大于销售量！无法退货！", vbOKOnly + vbInformation, "注意"
      rs_check.Close
      Exit Sub
   End If
   '加入退货表
   Dim sqlback As String
   sqlback = "select * from retreat"
   rs_back.Open sqlback, conn, adOpenKeyset, adLockPessimistic
   rs_back.AddNew
       rs_back.Fields(1) = txtFc.Text
       rs_back.Fields(2) = txtName.Text
       rs_back.Fields(3) = txtType.Text
       rs_back.Fields(4) = txtPrice.Text
       rs_back.Fields(5) = Val(txtQuantity.Text)
       rs_back.Fields(6) = Val(txtmoney.Text)
       rs_back.Fields(7) = txtyear.Text
       rs_back.Fields(8) = txtmon.Text
       rs_back.Fields(9) = txtday.Text
       rs_back.Fields(10) = txtem.Text
   rs_back.Update
   rs_back.Close
   
   '从销售商品表中减去
   Dim sqlbuy As String
   '以下两变量用于保存未减去之前的相应项的值
   Dim oldquantity As Long
   Dim oldmoney As Long
   odlmoney = rs_check.Fields(6)
   oldquantity = rs_check.Fields(5)
   rs_check.Fields(5) = oldquantity - Val(txtQuantity.Text)
   rs_check.Fields(6) = oldmoney - Val(txtmoney.Text)
   rs_check.Update
   rs_check.Close
   '加入现存商品表中
   sqlbuy = "select * from goods"
   rs_buy.Open sqlbuy, conn, adOpenKeyset, adLockPessimistic
   rs_buy.AddNew
       rs_buy.Fields(1) = txtFc.Text
       rs_buy.Fields(2) = txtName.Text
       rs_buy.Fields(3) = txtType.Text
       rs_buy.Fields(4) = txtPrice.Text
       rs_buy.Fields(5) = Val(txtQuantity.Text)
       rs_buy.Fields(6) = Val(txtmoney.Text)
       rs_buy.Fields(7) = txtyear.Text
       rs_buy.Fields(8) = txtmon.Text
       rs_buy.Fields(9) = txtday.Text
       rs_buy.Fields(10) = txtem.Text
   rs_buy.Update
   rs_buy.Close
   MsgBox "退货成功！", vbOKOnly + vbExclamation, "注意"
End Sub

Private Sub Form_Load()
    '让窗体居中
    Call MakeCenter(Me)
End Sub