frmpd_out.frm

雨点进销存软件,绝对可以用,大家可以拿来使用

      Width           =   2055
   End
End
Attribute VB_Name = "FrmPD_out"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Private Sub CbxFactory_Click()
Call PDKindView
End Sub

Private Sub CbxFactory_Change()
Call PDKindView
End Sub

Private Sub cmdNext_Click()
On Error GoTo Err
Dim rd As Recordset
Dim pd_no As String
Dim i As String

i = 1
Set rd = gDbFish.OpenRecordset("select * from product_out")
While Not rd.EOF
  i = i + 1
  rd.MoveNext
Wend
 pd_no = "O-000000" + Trim(i)
 LblDisplaypd_no = pd_no
 txtpd_name.Text = ""
 Txtpd_model.Text = ""
 txtpd_price.Text = "#.##"
 txtpd_sum.Text = "#.##"
 txtpd_trunk.Text = ""
 txtpd_amount.Text = ""
 txtpd_standard.Text = ""
 txtpd_remark.Text = ""
 CmdSave.Enabled = True
 Call Form_Load
Err:
End Sub

Private Sub CmdSave_Click()

On Error GoTo Err
Dim sql As String
Dim sql_f As String
Dim sql_s As String
Dim rd As Recordset
Dim rs As Recordset
Dim ro As Recordset
Dim i As String
Dim tDate As String
Dim tPd_ID As String
Dim tpd_trunk As String
Dim tpd_amount As String


i = 1
Set ro = gDbFish.OpenRecordset("select * from product_out")
Set rs = gDbFish.OpenRecordset("select * from product_stock")
While Not ro.EOF
  i = i + 1
  ro.MoveNext
Wend

If txtpd_name.Text = "" Then
  MsgBox "您未输入产品名称,请输入!", vbExclamation, "系统提示"
  Exit Sub
End If

If Txtpd_model.Text = "" Then
  MsgBox "您未输入产品型号,请输入!", vbExclamation, "系统提示"
  Exit Sub
End If

'Set rd = gDbFish.OpenRecordset("select * from product_in")
tDate = Convert_Value(Date, 1, 3, True, True) '日期格式
tPd_ID = 1



If rs.EOF Then
   sql = "insert into product_out (pd_no,pd_id,pd_name,pd_model,pd_factory,pd_trunk_in,pd_standard,pd_amount_in,pd_price_in,pd_sum_in,pd_date_in,pd_remark_in,pd_type,pd_in_user) values('" + i + "','" + tPd_ID + "','" + Trim(txtpd_name) + "','" + Trim(Txtpd_model) + "','" + Trim(CbxFactoryView) + "','" + Trim(txtpd_trunk) + "','" + Trim(txtpd_standard) + "','" + Trim(txtpd_amount) + "','" + Trim(txtpd_price) + "','" + Trim(txtpd_sum) + "'," + Trim(tDate) + ",'" + Trim(txtpd_remark) + "','" + Trim(CbxPDKind) + "','" + Trim(user_name) + "')"
 ' sql = "insert into product_in (pd_name,pd_model,pd_factory,pd_trunk_in,pd_standard,pd_amount_in,pd_price_in,pd_sum_in,pd_date_in,pd_remark_in,pd_type,pd_in_user) values('" + Trim(Txtpd_name) + "','" + Trim(Txtpd_model) + "','" + Trim(CbxFactoryView) + "','" + Trim(Txtpd_trunk) + "','" + Trim(Txtpd_standard) + "','" + Trim(Txtpd_amount) + "','" + Trim(Txtpd_price) + "','" + Trim(Txtpd_sum) + "','" + Trim(Date) + "','" + Trim(Txtpd_remark) + "','" + Trim(CbxPDKind) + "','" + Trim(user_name) + "')"
  sql_s = "insert into product_stock (pd_no,pd_id,pd_name,pd_model,pd_factory,pd_trunk_in,pd_standard,pd_trunk,pd_amount,pd_amount_in,pd_price_in,pd_sum_in,pd_date_in,pd_remark_in,pd_type,pd_in_user) values('" + i + "','" + tPd_ID + "','" + Trim(txtpd_name) + "','" + Trim(Txtpd_model) + "','" + Trim(CbxFactoryView) + "','" + Trim(txtpd_trunk) + "','" + Trim(txtpd_standard) + "','" + Trim(rs.Fields("pd_trunk") + Trim(txtpd_trunk)) + "','" + Trim(rs.Fields("pd_amount") + Trim(txtpd_amount)) + "','" + Trim(txtpd_amount) + "','" + Trim(txtpd_price) + "','" + Trim(txtpd_sum) + "',tDate,'" + Trim(txtpd_remark) + "','" + Trim(CbxPDKind) + "','" + Trim(user_name) + "')"

  gDbFish.Execute sql
  gDbFish.Execute sql_s
  MsgBox "数据输入成功", vbOKOnly, "系统提示!"
  CmdOk.Enabled = False
  Exit Sub

End If


While Not rs.EOF
  If Trim(CbxFactory.Text) = Trim(rs.Fields("pd_factory")) And Trim(CbxPDKind.Text) = Trim(rs.Fields("pd_type")) Then
     If Trim(txtpd_name.Text) = Trim(rs.Fields("pd_name")) Then   '输入同一种产品(相同的厂家,类型,名称,型号)
       If Trim(Txtpd_model.Text) = Trim(rs.Fields("pd_model")) Then
         sql_f = "select * from product_stock where pd_name='" + Trim(txtpd_name.Text) + "'and  pd_model='" + Trim(Txtpd_model.Text) + "' and  pd_factory='" + Trim(CbxFactory.Text) + "'and  pd_type='" + Trim(CbxPDKind.Text) + "' "
         Set rd = gDbFish.OpenRecordset(sql_f)               '确定输入库存表的数据指针
                  
         While Not rd.EOF
'             If Trim(txtpd_name.Text) = Trim(rs.Fields("pd_name")) Then
'             Set rds = gDbFish.OpenRecordset("select * from product_stock where pd_name='trim(txtpdo_name)'")
            If CInt(Trim(txtpd_amount.Text)) <= CInt(Trim(rd.Fields("pd_amount"))) Then
              GoTo Save
                                     
            Else
                MsgBox "产品数量超过库存数量,请确认!", vbOKOnly, "系统提示"
                Exit Sub
            End If

'             Else
            rs.MoveNext
'             End If
         Wend
       Else
       MsgBox "没有产品 " + Trim(txtpd_name.Text) + " 的 " + Trim(Txtpd_model.Text) + " 类的型号,请确认!", vbOKOnly, "系统提示"
     End If
            
Save:
        tpd_trunk = CInt(Trim(rd.Fields("pd_trunk")) - CInt(Trim(txtpd_trunk)))
        
        tpd_amount = CInt(Trim(rd.Fields("pd_amount")) - CInt(Trim(txtpd_amount)))
        sql = "insert into product_out (pd_no,pd_id,pd_name,pd_model,pd_factory,pd_trunk_out,pd_standard,pd_amount_out,pd_price_out,pd_sum_out,pd_date_out,pd_remark_out,pd_type,pd_out_user) values('" + i + "','" + Trim(rd.Fields("pd_id")) + "','" + Trim(txtpd_name) + "','" + Trim(Txtpd_model) + "','" + Trim(CbxFactory) + "','" + Trim(txtpd_trunk) + "','" + Trim(txtpd_standard) + "','" + Trim(txtpd_amount) + "','" + Trim(txtpd_price) + "','" + Trim(txtpd_sum) + "'," + Trim(tDate) + ",'" + Trim(txtpd_remark) + "','" + Trim(CbxPDKind) + "','" + Trim(user_name) + "')"
         sql_s = " update product_stock set  pd_trunk_out='" + Trim(txtpd_trunk) + "',pd_amount_out='" + Trim(txtpd_amount) + "', pd_trunk='" + tpd_trunk + "' ,pd_amount='" + tpd_amount + "', pd_price_out='" + Trim(txtpd_price) + "',pd_sum_out='" + Trim(txtpd_sum) + "',pd_date_out=" + Trim(tDate) + ",pd_remark_out='" + Trim(txtpd_remark) + "',pd_out_user='" + Trim(user_name) + "' where pd_name='" + Trim(txtpd_name.Text) + "'and  pd_model='" + Trim(Txtpd_model.Text) + "' and  pd_factory='" + Trim(CbxFactory.Text) + "'and  pd_type='" + Trim(CbxPDKind.Text) + "'"
        
        
        gDbFish.Execute sql
        gDbFish.Execute sql_s
        MsgBox "数据输入成功", vbOKOnly, "系统提示!"
        CmdSave.Enabled = False
        Exit Sub
      End If
  End If
'    tPd_ID = rs.Fields("pd_id")
    rs.MoveNext
Wend

MsgBox "对不起,没有该产品,请确认!", vbOKOnly, "系统提示"



Err:
'
'' 出货时把入库情况和出去情况一起写入到product_stoct表中，以备查询
'Save:


End Sub

Private Sub Form_Load()
Call FactoryView
Dim rd As Recordset
Dim pd_no As String
Dim i As String

i = 1
Set rd = gDbFish.OpenRecordset("select * from product_out")
While Not rd.EOF
  i = i + 1
  rd.MoveNext
Wend


  pd_no = "O-000000" + Trim(i)


LblDisplaypd_no = pd_no
End Sub
Private Sub PDKindView()
    Dim rs As Recordset
    CbxPDKind.Clear
    Set rs = gDbFish.OpenRecordset("select * from product_kind")
    While Not rs.EOF
        CbxPDKind.AddItem Trim(rs.Fields("pd_kind_name"))
        rs.MoveNext
    Wend
   If CbxPDKind.ListCount > 1 Then CbxPDKind.ListIndex = 0
End Sub
Private Sub FactoryView()
    Dim rs As Recordset
    CbxFactory.Clear
    Set rs = gDbFish.OpenRecordset("select * from factory_info")
    
    While Not rs.EOF
      CbxFactory.AddItem Trim(rs.Fields("fct_name"))
      rs.MoveNext
    Wend
 If CbxFactory.ListCount > 1 Then CbxFactory.ListIndex = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call FrmMain.CmdQuit_Click
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
   Case "tbSave"
      Call CmdSave_Click
   Case "tbAdd"
      Call cmdNext_Click
   Case "tbBack"
      Me.Hide
      FrmMain.Show 1
   Case "tbExit"
      Call FrmMain.CmdQuit_Click
End Select
End Sub

Private Sub txtpdo_model_KeyDown(KeyCode As Integer, Shift As Integer)
Dim rd As Recordset
Dim sql As String

If KeyCode = 13 Or KeyCode = 40 Then
txtpdo_trunk.SetFocus
sql = "select * from product_in where pd_name='" + Trim(txtpdo_name) + "' and pd_model='" + Trim(txtpdo_model) + "'"
Set rd = gDbFish.OpenRecordset(sql)
txtpdo_standard.Text = Trim(rd.Fields("pd_standard"))
End If

End Sub

Private Sub Txtpd_amount_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo Err
If KeyCode = 13 Or KeyCode = 40 Then
txtpd_price.SetFocus
txtpd_price.Text = ""
End If
Err:
End Sub

Private Sub Txtpd_model_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo Err

Dim rd As Recordset
Dim sql As String


If KeyCode = 13 Or KeyCode = 40 Then
    
    sql = "select * from product_stock where pd_name='" + Trim(txtpd_name.Text) + "'and  pd_model='" + Trim(Txtpd_model.Text) + "' and  pd_factory='" + Trim(CbxFactory.Text) + "'and  pd_type='" + Trim(CbxPDKind.Text) + "' "
    Set rd = gDbFish.OpenRecordset(sql)
    If Not rd.EOF Then
      txtpd_standard.Text = Trim(rd.Fields("pd_standard"))
      txtpd_standard.BackColor = vbYellow
      txtpd_trunk.SetFocus
    Else
      txtpd_standard.SetFocus
    End If

End If
Err:
End Sub

Private Sub Txtpd_name_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo Err
  If KeyCode = 13 Or KeyCode = 40 Then Txtpd_model.SetFocus
Err:
End Sub

Private Sub Txtpd_price_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo Err
If txtpd_amount.Text <> "" And txtpd_price.Text <> "" Then
txtpd_sum.Text = txtpd_amount.Text * txtpd_price.Text
End If
If KeyCode = 13 Or KeyCode = 40 Then
txtpd_sum.SetFocus

End If
Err:
End Sub

Private Sub txtpd_remark_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo Err
If KeyCode = 13 Or KeyCode = 40 Then CmdSave.SetFocus

Err:
End Sub

Private Sub Txtpd_standard_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo Err
If KeyCode = 13 Or KeyCode = 40 Then txtpd_trunk.SetFocus

Err:
End Sub



Private Sub Txtpd_sum_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo Err
If KeyCode = 13 Or KeyCode = 40 Then txtpd_remark.SetFocus

Err:
End Sub

Private Sub Txtpd_trunk_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo Err
If KeyCode = 13 Or KeyCode = 40 Then txtpd_amount.SetFocus
If txtpd_trunk.Text <> "" And txtpd_standard.Text <> "" Then
  txtpd_amount.Text = txtpd_trunk.Text * txtpd_standard.Text
End If
Err:
End Sub