frmth.frm

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

                .Fields("单价") = CCur(LTrim(txtdj.Text))
                .Fields("数量") = LTrim(txtquan.Text)
                .Fields("总金额") = -CCur(LTrim(txtdj.Text)) * CLng(LTrim(txtquan.Text))
                .Fields("发货单日期") = CDate(LTrim(txtdate.Text))
                .Fields("备注") = LTrim(txtbz.Text)
                .Fields("发货") = False
                .Fields("客户编号") = LTrim(txtkh.Text)
                .Fields("单位名称") = LTrim(txtname.Text)
                .Fields("操作员") = txtczy.Text
                .Update
                .Close
           End With
           txtth.Text = ""
           txtcp.Text = ""
           txtdw.Text = ""
           txtdj.Text = ""
           txtquan.Text = ""
           txtzje.Text = ""
           txtbz.Text = ""
           txtname.Text = ""
           txtname.Locked = True
           txtdate.Text = ""
           txtkh.Text = ""
           txtkh.Enabled = False
           Command2.Enabled = False
           Command1.Enabled = True
           txtth.Enabled = False
           txtcp.Enabled = False
           txtdw.Enabled = False
           txtdj.Enabled = False
           txtquan.Enabled = False
           txtzje.Enabled = False
           txtbz.Enabled = False
           txtdate.Enabled = False
        Else
          MsgBox "此产品编号不存在,请重新输入!", vbCritical, "错误"
          Command3.SetFocus
        End If
     Else
        txtid.SetFocus
     End If
End If
db.Close
a:
  If Err.Number = 13 Then
     MsgBox "日期非法，格式为年-月-日!请重新输入!", vbCritical, "错误"
     txtdate.SetFocus
  End If
     
 
End Sub

Private Sub Command3_Click()
  Unload Me
  frmmenu.Show
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
  Dim str As String
  Set db = OpenDatabase("xsys", dbDriverNoPrompt, False, "odbc;database=glxt;uid=;pwd=;dsn=xsys")
  str = "fdk" & CStr(Year(Now))
  sql = "select * from " + str + " where [发货]=true"
  Set rs1 = db.OpenRecordset(sql, dbOpenDynaset, dbwrite, dbOptimistic)
  If txtfh.Text = "" Or txtcp.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("发货单编号") = Trim(txtfh.Text) And rs.Fields("产品编号") = Trim(txtcp.Text) Then
           cx = True
           Exit Do
        Else
           rs.MoveNext
        End If
     Loop
     If cx = True Then
        Set rs2 = db.OpenRecordset("temp", dbOpenDynaset, dbwrite, dbOptimistic)
        With rs2
             .AddNew
             .Fields("发货单编号") = Trim(txtth.Text)
             .Fields("产品编号") = Trim(txtcp.Text)
             .Fields("单位") = Trim(txtdw.Text)
             .Fields("单价") = CCur(LTrim(txtdj.Text))
             .Fields("数量") = Trim(txtquan.Text)
             .Fields("总金额") = -CCur(LTrim(txtdj.Text)) * CLng(LTrim(txtquan.Text))
             .Fields("发货单日期") = CDate(LTrim(txtdate.Text))
             .Fields("备注") = Trim(txtbz.Text)
             .Fields("发货") = False
             .Fields("客户编号") = Trim(txtkh.Text)
             .Fields("单位名称") = Trim(txtname.Text)
             .Fields("操作员") = txtczy.Text
             .Update
             .Close
        End With
        txtth.Text = ""
        txtth.Locked = True
        txtfh.Text = ""
        txtcp.Text = ""
        txtdw.Text = ""
        txtdw.Locked = True
        txtdj.Text = ""
        txtquan.Text = ""
        txtzje.Text = ""
        txtzje.Locked = True
        txtbz.Text = ""
        txtname.Text = ""
        txtname.Locked = True
        txtdate.Text = ""
        txtkh.Text = ""
        txtkh.Locked = True
        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 = 0
           txtsl.Text = 0
           txtzje.Text = 0
           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
           commok.Enabled = False
           Command2.Enabled = True
           Command2.SetFocus
        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 = 11 Then
                 Command2.SetFocus
                 Exit For
              End If
          Next i
          KeyAscii = 0
        End If
          
End Sub

Private Sub Form_Load()
  txtth.Enabled = False
  txtcp.Enabled = False
  txtdw.Enabled = False
  txtdj.Enabled = False
  txtfh.Enabled = False
  txtquan.Enabled = False
  txtzje.Enabled = False
  txtbz.Enabled = False
  txtname.Enabled = False
  txtdate.Enabled = False
  txtkh.Enabled = False
  Command2.Enabled = False
  txtczy.Text = frmlogin.Combo1.Text
  txtczy.Locked = True
End Sub

Private Sub txtcp_LostFocus()
  On Error GoTo a
  DefaultType = dbUseODBC
  Dim db As Database
  Dim sql As String
  Dim rs As Recordset
  Dim str As String
  Dim cx As Boolean
  cx = False
  Set db = OpenDatabase("xsys", dbDriverNoPrompt, False, "odbc;database=glxt;uid=;pwd=;dsn=xsys")
  str = "fdk" & CStr(Year(Now))
  sql = "select * from " + str + " where [发货]=true"
  Set rs = db.OpenRecordset(sql, dbOpenDynaset, dbwrite, dbOptimistic)
  If txtth.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("产品编号") = Trim(txtcp.Text) And rs.Fields("发货单编号") = Trim(txtfh.Text) Then
           cx = True
           Exit Do
        Else
           rs.MoveNext
        End If
     Loop
     If cx = False Then
        MsgBox "此编号不存在,请重新输入!", vbCritical, "错误"
        txtcp.Text = ""
     Else
        txtkh.Text = rs.Fields("客户编号")
        txtname.Text = rs.Fields("单位名称")
        txtdw.Text = rs.Fields("单位")
        txtdj.Text = rs.Fields("单价")
        txtquan.Text = rs.Fields("数量")
        txtzje.Text = rs.Fields("总金额")
        txtzje.Locked = True
        txtbz.Text = rs.Fields("备注")
        
        
     End If
  End If
  rs.Close
  db.Close
a:
  If Err.Number = 94 Then
     txtdw.SetFocus
  End If
End Sub

Private Sub txtfh_LostFocus()
  DefaultType = dbUseODBC
  Dim db As Database
  Dim rs As Recordset
  Dim str As String
  Dim sql As String
  Dim cx As Boolean
  cx = False
  str = "fdk" & CStr(Year(Now))
  sql = "select * from " + str + " where [发货]=true"
  Set db = OpenDatabase("xsys", dbDriverNoPrompt, False, "odbc;database=glxt;uid=;pwd=;dsn=xsys")
  Set rs = db.OpenRecordset(sql, dbOpenDynaset, dbwrite, dbOptimistic)
  rs.MoveFirst
  Do While rs.EOF <> True
     If rs.Fields("发货单编号") = Trim(txtfh.Text) Then
        cx = True
        Exit Do
     Else
        rs.MoveNext
     End If
  Loop
  If txtfh.Text = "" Then
     MsgBox "发货单编号不能为空，请重新输入！"
  Else
     If cx = False Then
        MsgBox "此发货单编号不存在,请重新输入!", vbCritical, "错误"
        txtfh.Text = ""
     Else
        txtth.Text = "T" & txtfh.Text
        txtkh.Text = rs.Fields("客户编号")
        txtname.Text = rs.Fields("单位名称")
        txtdw.Text = rs.Fields("单位")
        txtth.Locked = True
        txtkh.Locked = True
        txtname.Locked = True
        txtdw.Locked = True
     End If
  End If
  rs.Close
  db.Close
End Sub

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