frmin.frm

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

      Width           =   1575
   End
End
Attribute VB_Name = "frmin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Command1_Click()
  txtid.Enabled = True
  txttm.Enabled = True
  txtgg.Enabled = True
  txtquan.Enabled = True
  txtdate.Enabled = True
  txtid.Locked = False
  txttm.Locked = True
  txtgg.Locked = True
  txtquan.Locked = False
  txtdw.Enabled = True
  Command1.Enabled = False
  Command2.Enabled = False
  commok.Enabled = True
  txtdw.Text = "箱"
  txtdw.Locked = True
  txtdate.Text = Year(Now) & "-" & Month(Now) & "-" & Day(Now)
  txtdate.Locked = True
  txtid.SetFocus
  Dim db As Database
  Dim wk As Workspace
  Set wk = DBEngine.Workspaces(0)
  Dim rs1 As Recordset
  Set db = OpenDatabase("xsys", dbDriverNoPrompt, False, "odbc;database=glxt;uid=;pwd=;dsn=xsys")
  wk.BeginTrans
  Set rs1 = db.OpenRecordset("rktemp", dbOpenDynaset, dbwrite, dbOptimistic)
  rs1.MoveFirst
  Do While rs1.EOF <> True
     rs1.Delete
     rs1.MoveNext
     If rs1.EOF = True Then
        Exit Do
     End If
  Loop
  wk.CommitTrans
  Data1.Connect = access
  Data1.DefaultType = 1
  Data1.DatabaseName = "xsys"
  DBGrid1.Refresh
  db.Close
End Sub
Private Sub Command2_Click()
  DefaultType = dbUseODBC
  Dim db As Database
  Dim sql As String
  Dim str As String
  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("rktemp", dbOpenDynaset, dbwrite, dbOptimistic)
  Set rs2 = db.OpenRecordset("xhk", dbOpenDynaset, dbwrite, dbOptimistic)
  rs1.MoveFirst
  Do While rs1.EOF <> True
     rs2.MoveFirst
     Do While rs2.EOF <> True
        If rs2.Fields("产品编号") = rs1.Fields("产品编号") Then
           rs2.Edit
           rs2.Fields("数量") = rs2.Fields("数量") + rs1.Fields("数量")
           rs2.Update
           Exit Do
        Else
           rs2.MoveNext
        End If
        If rs2.EOF = True Then
           Exit Do
        End If
     Loop
     rs1.MoveNext
     If rs1.EOF = True Then
        Exit Do
     End If
  Loop
 rs1.Close
 rs2.Close
 str = "rdk" & CStr(Year(Now))
 sql = "insert into [" + str + "] select * from [rktemp]"
 db.Execute sql
 If MsgBox("入库已成功，是否打印入库单?", vbYesNo, "打印") = vbYes Then
    CommonDialog1.ShowPrinter
    Printer.Orientation = vbPRORPortrait
    Printer.PaperSize = vbPRPSA4
    Printer.ScaleMode = vbMillimeters
    Printer.FontName = "宋体"
    Printer.FontSize = 18
    sql = "select * from rktemp"
    Set rs1 = db.OpenRecordset(sql, dbOpenDynaset, dbwrite, dbOptimistic)
    Printer.CurrentX = 60
    Printer.CurrentY = 15
    Printer.Print "扬州市兴盛牙刷厂入库单"
    Printer.Line (50, 22)-(140, 22)
    Printer.Line (50, 23)-(140, 23)
    rs1.MoveFirst
    Printer.FontSize = 10
    Printer.CurrentX = 29.5
  Printer.CurrentY = 41.5
  Printer.Line (29.5, 41.5)-(150, 41.5)
  Printer.CurrentX = 29
  Printer.CurrentY = 42
  Printer.Line (30, 42)-(30, 47)
  Printer.CurrentX = 31
  Printer.CurrentY = 42
  Printer.Print "  产品型号"
  Printer.CurrentX = 55
  Printer.CurrentY = 42
     Printer.Line (56, 42)-(56, 47)
     Printer.CurrentX = 62
     Printer.CurrentY = 42
     Printer.Print "  数   量（箱）"
     Printer.CurrentX = 91
     Printer.CurrentY = 42
     Printer.Line (92, 42)-(92, 47)
     Printer.CurrentX = 93
     Printer.CurrentY = 42
     Printer.Print "  入库日期"
     Printer.CurrentX = 120
     Printer.CurrentY = 42
     Printer.Line (120, 42)-(120, 47)
     Printer.CurrentX = 121
     Printer.CurrentY = 42
     Printer.Print "  操作员"
     
     
     
     Printer.CurrentX = 150
     Printer.CurrentY = 42
     Printer.Line (150, 42)-(150, 47)
     Printer.Line (30, 47)-(150, 47)
     CurrentY = 47
     Do While rs1.EOF <> True
          Printer.FontSize = 10
          CurrentX = 29.75
          Printer.Line (CurrentX, CurrentY)-(CurrentX, CurrentY + 5)
          CurrentX = CurrentX + 1
          Printer.CurrentX = CurrentX
          Printer.CurrentY = CurrentY + 1
          Printer.Print rs1.Fields("产品编号")
          CurrentX = CurrentX + 25
          Printer.Line (CurrentX, CurrentY)-(CurrentX, CurrentY + 5)
          CurrentX = CurrentX + 1
          Printer.CurrentX = CurrentX
          Printer.CurrentY = CurrentY + 1
          Printer.Print rs1.Fields("数量")
          CurrentX = CurrentX + 35
          Printer.Line (CurrentX, CurrentY)-(CurrentX, CurrentY + 5)
          CurrentX = CurrentX + 1
          Printer.CurrentX = CurrentX
          Printer.CurrentY = CurrentY + 1
          Printer.Print rs1.Fields("入库日期")
          CurrentX = CurrentX + 27
          Printer.Line (CurrentX, CurrentY)-(CurrentX, CurrentY + 5)
          Printer.CurrentX = CurrentX + 2
          Printer.CurrentY = CurrentY + 1
          Printer.Print rs1.Fields("操作员")
          CurrentX = CurrentX + 30
          Printer.Line (CurrentX, CurrentY)-(CurrentX, CurrentY + 5)
          Printer.Line (30, CurrentY + 5)-(150, CurrentY + 5)
          CurrentY = CurrentY + 5
          rs1.MoveNext
          If rs1.EOF = True Then
             Exit Do
          End If
     Loop
     Printer.EndDoc
     rs1.Close
  End If
    Set rs1 = db.OpenRecordset("rktemp", dbOpenDynaset, dbwrite, dbOptimistic)
  rs1.MoveFirst
  Do While rs1.EOF <> True
     rs1.Delete
     rs1.MoveNext
     If rs1.EOF = True Then
        Exit Do
     End If
  Loop
 wk.CommitTrans
 Command2.Enabled = False
 commok.Enabled = False
 Command1.Enabled = True
 txtid.Text = ""
 txtdw.Text = ""
 txtdw.Enabled = False
 txttm.Text = ""
 txtgg.Text = ""
 txtquan.Text = ""
 txtdate.Text = ""
 txtid.Enabled = False
 txttm.Enabled = False
 txtgg.Enabled = False
 txtquan.Enabled = False
 txtdate.Enabled = False
 Data1.RecordSource = "select * from rktemp"
 Data1.Refresh

  
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
  Set db = OpenDatabase("xsys", dbDriverNoPrompt, False, "odbc;database=glxt;uid=;pwd=;dsn=xsys")
  wk.BeginTrans
  Set rs1 = db.OpenRecordset("xhk", dbOpenDynaset, dbwrite, dbOptimistic)
  If txtid.Text = "" Then
     If MsgBox("编号不能为空,请重新输入!", vbCritical, "错误") = vbOK Then
        Command3.SetFocus
     End If
  Else
     rs1.MoveFirst
     Do While rs1.EOF <> True
        If rs1.Fields("产品编号") = LTrim(txtid.Text) Then
           cx = True
           Exit Do
        Else
           rs1.MoveNext
        End If
     Loop
     If cx = True Then
        txttm.Text = rs1.Fields("条码")
        txtgg.Text = rs1.Fields("规格")
        Set rs2 = db.OpenRecordset("rktemp", dbOpenDynaset, dbwrite, dbOptimistic)
        With rs2
             .AddNew
             .Fields("产品编号") = Trim(txtid.Text)
             .Fields("数量") = Trim(CLng(txtquan.Text))
             .Fields("操作员") = Trim(txtczy.Text)
             .Fields("入库日期") = Trim(txtdate.Text)
             .Fields("单位") = Trim(txtdw.Text)
             .Update
             .Close
        End With
        wk.CommitTrans
        Data1.Connect = access
        Data1.DefaultType = 1
        Data1.DatabaseName = "xsys"
        Data1.RecordSource = "select * from rktemp"
        Data1.Refresh
        If MsgBox("继续入库吗?", vbYesNo, "提示") = vbYes Then
           txtid.Text = ""
           txtgg.Text = ""
           txttm.Text = ""
           txtquan.Text = 0
           txtid.SetFocus
        Else
            txtid.Enabled = False
            txttm.Enabled = False
            txtgg.Enabled = False
            txtquan.Enabled = False
            txtczy.Text = frmlogin.Combo1.Text
            txtczy.Locked = True
             Command2.Enabled = False
             txtdate.Enabled = False
           commok.Enabled = False
           txtdw.Enabled = False
            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 = 6 Or nexttabindex = 8 Then
                 commok.SetFocus
                 Exit For
              End If
          Next i
          KeyAscii = 0
        End If
          
End Sub

Private Sub Form_Load()
  txtid.Enabled = False
  txttm.Enabled = False
  txtgg.Enabled = False
  txtquan.Enabled = False
  txtczy.Text = frmlogin.Combo1.Text
  txtczy.Locked = True
  Command2.Enabled = False
  txtdate.Enabled = False
  commok.Enabled = False
  txtdw.Enabled = False
End Sub
Private Sub txtid_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 txtid.Text = "" Then
     MsgBox "填写不能为空,请重新输入!", vbOKCancel, "错误"
     Command3.SetFocus
  Else
     rs.MoveFirst
     Do While rs.EOF <> True
        If rs.Fields("产品编号") = LTrim(txtid.Text) Then
           cx = True
           Exit Do
        Else
           rs.MoveNext
        End If
     Loop
     If cx = False Then
        MsgBox "此产品编号不存在,请重新输入!", vbCritical, "错误"
        txtid.Text = ""
        txtid.SetFocus
     Else
        txttm.Text = rs.Fields("条码")
        txtgg.Text = rs.Fields("规格")
        txtquan.Text = 0
        txttm.Locked = True
        txtgg.Locked = True
        txtquan.SetFocus
     End If
     rs.Close
     db.Close
  End If
End Sub


Private Sub txtquan_LostFocus()
  If txtquan.Text = "" Then
     txtquan.Text = 0
  End If
  commok.SetFocus
End Sub