frmout.frm

以前写的一个销售的管理系统,是牙刷销存管理系统,有销售,进货等功能,刚学ＶＢ时写的

        Exit Do
     End If
  Loop
 Command2.Enabled = False
 commok.Enabled = False
 Command1.Enabled = True
 txtfh.Text = ""
 txtcp.Text = ""
 txtdw.Text = ""
 txtgg.Text = ""
 txtdj.Text = ""
 txtsl.Text = ""
 txtzje.Text = ""
 txtysr.Text = ""
 txtch.Text = ""
 txtbz.Text = ""
 txtkh.Text = ""
 txtname.Text = ""
 txtname.Enabled = False
 txtkh.Enabled = False
 txtdate.Text = ""
 Command2.Enabled = False
 Command1.Enabled = True
 txtfh.Enabled = False
 txtcp.Enabled = False
 txtdw.Enabled = False
 txtdj.Enabled = False
 txtsl.Enabled = False
 txtzje.Enabled = False
 txtysr.Enabled = False
 txtch.Enabled = False
 txtbz.Enabled = False
 txtdate.Enabled = False
End If
wk.CommitTrans
Data1.RecordSource = "select * from temp"
 Data1.Refresh
End Sub

Private Sub Command3_Click()
  Unload Me
  frmmenu.Show
  
End Sub

Private Sub Command4_Click()

End Sub

Private Sub commok_Click()
  On Error GoTo a
  DefaultType = dbUseODBC
  Dim db As Database
  Dim wk As Workspace
  Set wk = DBEngine.Workspaces(0)
  Dim rs1 As Recordset
  Dim rs2 As Recordset
  Set db = OpenDatabase("xsys", dbDriverNoPrompt, False, "odbc;database=glxt;uid=;pwd=;dsn=xsys")
  wk.BeginTrans
  Set rs1 = db.OpenRecordset("xhk", dbOpenDynaset, dbwrite, dbOptimistic)
  If txtcp.Text = "" Or txtname.Text = "" Then
     If MsgBox("编号不能为空,请重新输入!", vbCritical, "错误") = vbOK Then
        Command3.SetFocus
     End If
  Else
     rs1.MoveFirst
     Do While rs1.EOF <> True
        If rs1.Fields("产品编号") = LTrim(txtcp.Text) Then
           cx = True
           Exit Do
        Else
           rs1.MoveNext
        End If
     Loop
     If cx = True Then
        If rs1.Fields("数量") = 0 Then
           MsgBox "已无库存,请先入库!", vbCritical, "错误"
           Command3.SetFocus
           rs1.Close
        Else
          If rs1.Fields("数量") - CLng(LTrim(txtsl.Text)) < 0 Then
             MsgBox "存货不足,请调整出库数量!", vbCritical, "错误"
             rs1.Close
             txtsl.SetFocus
          Else
             Set rs2 = db.OpenRecordset("temp", dbOpenDynaset, dbwrite, dbOptimistic)
             With rs2
                  .AddNew
                  .Fields("发货单编号") = LTrim(txtfh.Text)
                  .Fields("产品编号") = LTrim(txtcp.Text)
                  .Fields("规格") = LTrim(txtgg.Text)
                  .Fields("单位") = LTrim(txtdw.Text)
                  .Fields("单价") = CCur(LTrim(txtdj.Text))
                  .Fields("数量") = LTrim(txtsl.Text)
                  .Fields("总金额") = CCur(LTrim(txtdj.Text)) * CLng(LTrim(txtsl.Text))
                  .Fields("运输人") = LTrim(txtysr.Text)
                  .Fields("车号") = LTrim(txtch.Text)
                  .Fields("发货单日期") = CDate(LTrim(txtdate.Text))
                  .Fields("备注") = LTrim(txtbz.Text)
                  .Fields("发货") = True
                  .Fields("单位名称") = LTrim(txtname.Text)
                  .Fields("操作员") = txtczy.Text
                  .Fields("客户编号") = LTrim(txtkh.Text)
                  .Update
                  .Close
            End With
            wk.CommitTrans
            Data1.Connect = access
        Data1.DefaultType = 1
        Data1.DatabaseName = "xsys"
        Data1.RecordSource = "select 产品编号,规格,单位,单价,数量,总金额,发货单日期 from temp"
        Data1.Refresh
            If MsgBox("继续添加吗?", vbYesNo, "提示") = vbYes Then
               txtcp.Text = ""
               txtgg.Text = ""
               txtdj.Text = ""
               txtsl.Text = ""
               txtzje.Text = ""
               txtbz.Text = ""
               txtcp.SetFocus
            Else
               txtfh.Enabled = False
               txtcp.Enabled = False
               txtdw.Enabled = False
               txtdj.Enabled = False
               txtsl.Enabled = False
               txtname.Enabled = False
               txtzje.Enabled = False
               txtysr.Enabled = False
               txtch.Enabled = False
               txtbz.Enabled = False
               txtdate.Enabled = False
               txtgg.Enabled = False
               txtkh.Enabled = False
               txtczy.Text = frmlogin.Combo1.Text
               txtczy.Locked = True
               Command2.Enabled = False
               commok.Enabled = False
               commok.Enabled = False
               Command2.Enabled = True
               Command2.SetFocus
               frmsm.Show (1)
            End If
          End If
        End If
      Else
        MsgBox "此产品编号不存在,请重新输入!", vbCritical, "错误"
        txtfh.Text = ""
        txtfh.SetFocus
        rs2.Close
      End If
 End If
 db.Close
a:
  If Err.Number = 13 Then
     MsgBox "单价，数量不能是字符型！"
  End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
  Dim nexttabindex As Integer, i As Integer
       If KeyAscii = 13 Then
          If Screen.ActiveControl.TabIndex = Count - 1 Then
             nexttabindex = 0
          Else
             nexttabindex = Screen.ActiveControl.TabIndex + 1
          End If
          For i = 0 To Count - 1
              If Me.Controls(i).TabIndex = nexttabindex Then
                 Me.Controls(i).SetFocus
                 Exit For
              End If
              If nexttabindex = 13 Or nexttabindex = 15 Then
                 commok.SetFocus
                 Exit For
              End If
          Next i
          KeyAscii = 0
        End If
End Sub
Private Sub Form_Load()
  txtfh.Enabled = False
  txtcp.Enabled = False
  txtdw.Enabled = False
  txtdj.Enabled = False
  txtsl.Enabled = False
  txtname.Enabled = False
  txtzje.Enabled = False
  txtysr.Enabled = False
  txtch.Enabled = False
  txtbz.Enabled = False
  txtdate.Enabled = False
  txtgg.Enabled = False
  txtkh.Enabled = False
  txtczy.Text = frmlogin.Combo1.Text
  txtczy.Locked = True
  Command1.Enabled = True
  Command2.Enabled = False
  commok.Enabled = False
End Sub

Private Sub txtcp_LostFocus()
  DefaultType = dbUseODBC
  Dim db As Database
  Dim rs As Recordset
  Dim cx As Boolean
  cx = False
  Set db = OpenDatabase("xsys", dbDriverNoPrompt, False, "odbc;database=glxt;uid=;pwd=;dsn=xsys")
  Set rs = db.OpenRecordset("xhk", dbOpenDynaset, dbwrite, dbOptimistic)
  If txtfh.Text = "" Then
     If MsgBox("产品编号不能为空,请重新输入!", vbOKCancel, "错误") = vbOK Then
        Command3.SetFocus
     Else
        Command3.SetFocus
     End If
  Else
     rs.MoveFirst
     Do While rs.EOF <> True
        If rs.Fields("产品编号") = LTrim(txtcp.Text) Then
           cx = True
           txtgg.Text = rs.Fields("规格")
           txtdj.SetFocus
           Exit Do
        Else
           rs.MoveNext
        End If
     Loop
     rs.Close
     If cx = False Then
        MsgBox "此产品编号不存在,请重新输入!", vbCritical, "错误"
        txtcp.Text = ""
     Else
        If cx = True Then
           
           Set rs = db.OpenRecordset("temp", dbOpenDynaset, dbwrite, dbOptimistic)
           Do While rs.EOF <> True
              If rs.Fields("发货单编号") = LTrim(txtfh.Text) And rs.Fields("产品编号") = LTrim(txtcp.Text) Then
                 MsgBox "您不能在同一发货单上发产品编号一样的货,请重新输入!"
                
                 txtcp.Text = ""
                 txtcp.SetFocus
              Else
                 rs.MoveNext
              End If
              If rs.EOF = True Then
                
                 Exit Do
              End If
           Loop
        End If
     End If
  End If
  
  db.Close
End Sub

Private Sub txtdj_LostFocus()
  If txtdj.Text = "" Then
     txtdj.Text = 0
  End If
End Sub

Private Sub txtfh_GotFocus()
  DefaultType = dbUseODBC
  Dim db As Database
  Dim rs As Recordset
  Dim str As String
  Dim substr As String
  Dim yue As String
  Dim tian As String
  Dim totol As String
  yue = Month(Now)
  tian = Day(Now)
  If yue <= 9 Then
     yue = "0" & yue
  End If
  If tian <= 9 Then
     tian = "0" & tian
  End If
  cx = False
  On Error GoTo a
  str = "fdk" & CStr(Year(Now))
  Set db = OpenDatabase("xsys", dbDriverNoPrompt, False, "odbc;database=glxt;uid=;pwd=;dsn=xsys")
  Set rs = db.OpenRecordset(str, dbOpenDynaset, dbwrite, dbOptimistic)
  rs.MoveLast
  str = rs.Fields("发货单编号")
  substr = Mid(str, 5, 8)
  totol = Year(Now) & yue & tian
  If totol > substr Then
     txtfh.Text = txtkh.Text & CStr(Year(Now)) & yue & tian & "001"
  Else
     j = Right(str, 3)
     k = CInt(j) + 1
     Select Case k < 1000
     Case k < 10
          str = txtkh.Text & CStr(Year(Now)) & yue & tian & "0" & "0" & k
     Case k >= 10 And k < 100
          str = txtkh.Text & CStr(Year(Now)) & yue & tian & "0" & k
     Case k >= 100 And k < 1000
          str = txtkh.Text & CStr(Year(Now)) & yue & tian & k
     End Select
     txtfh.Text = str
  End If
a:
  If Err.Number = 3021 Then
     txtfh.Text = txtkh.Text & CStr(Year(Now)) & yue & tian & "001"
  End If
End Sub

Private Sub txtkh_LostFocus()
  DefaultType = dbUseODBC
  Dim db As Database
  Dim rs As Recordset
  Dim cx As Boolean
  cx = False
  Set db = OpenDatabase("xsys", dbDriverNoPrompt, False, "odbc;database=glxt;uid=;pwd=;dsn=xsys")
  Set rs = db.OpenRecordset("khk", dbOpenDynaset, dbwrite, dbOptimistic)
  If txtkh.Text = "" Then
     MsgBox "客户编号不能为空,请重新输入!", vbCritical, "错误"
     Command3.SetFocus
  Else
     rs.MoveFirst
     Do While rs.EOF <> True
        If rs.Fields("客户编号") = LTrim(txtkh.Text) Then
           cx = True
           Exit Do
        Else
           rs.MoveNext
        End If
     Loop
     If cx = False Then
        MsgBox "此客户编号不存在,请重新输入!", vbCritical, "错误"
        txtkh.Text = ""
        Command3.SetFocus
     Else
        txtfh.SetFocus
        txtname.Locked = False
        txtname.Text = rs.Fields("单位名称")
        txtname.Locked = True
     End If
  End If
  rs.Close
  db.Close
End Sub

Private Sub txtsl_LostFocus()
  If txtsl.Text = "" Then
     txtsl.Text = 0
  End If
End Sub

Private Sub txtzje_GotFocus()
  On Error GoTo a
  txtzje.Text = CCur(CCur(txtdj.Text) * CInt(txtsl.Text))
a:
  If Err.Number = 13 Then
     MsgBox "单价，数量不能是字符型！"
  End If
  
End Sub