main_rcyw_xs.frm

vb开发的一个仓库管理系统 很不错的 值得下载

   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "销 售 单"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   285
      Left            =   4980
      TabIndex        =   23
      Top             =   120
      Width           =   1275
   End
End
Attribute VB_Name = "main_rcyw_xs"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim s, y, i   '定义变量
Dim mydb1 As Database     '定义数据库
Dim rs1 As Recordset     '定义字段
Dim lsph As Integer     '定义一个整型变量
Private Sub Form_Load()
'自动识别数据库路径
 Data1.DatabaseName = App.Path & "\yyjxc.mdb"
 Data2.DatabaseName = App.Path & "\yyjxc.mdb"
 Data3.DatabaseName = App.Path & "\yyjxc.mdb"
 mf1.Rows = 102: mf1.Cols = 11     '定义mf1表的总行数、总列数
'定义mf1表的列宽和表头信息
 s = Array("300", "1500", "990", "1200", "1200", "1200", "750", "750", "900", "1200", "700")
 y = Array("xh", "商品名称", "批号", "厂家", "规格", "包装", "单位", "数量", "单价", "金额", "备注")
 For i = 0 To 10
  mf1.ColWidth(i) = s(i): mf1.TextMatrix(0, i) = y(i)
 Next i
 mf1.FixedRows = 1: mf1.FixedCols = 1     '定义mf1表的固定行数、固定列数
 For i = 1 To 101
      mf1.TextMatrix(i, 0) = i
 Next i
 rq.Text = Date     '设置销售日期
End Sub
Private Sub Form_Unload(Cancel As Integer)
  frm_main.Enabled = True
End Sub
Private Sub mf1_Click()
If mf1.Row >= 1 And mf1.TextMatrix(mf1.Row - 1, 8) <> "" Then     '在mf1表格第1行或大于第1行时
 Text1.Visible = True     'text1可见
 Text1.SetFocus
End If
End Sub
Private Sub mf1_entercell()
 frm_main.Text1.Text = "3"
 Call frm_main.entercell     '调用函数
End Sub
Private Sub mf1_RowColChange()     '格式化金额
For i = 1 To 101
If mf1.TextMatrix(i, 1) <> "" Then
 mf1.TextMatrix(i, 8) = Format(mf1.TextMatrix(i, 8), "#0.000")
 mf1.TextMatrix(mf1.Row, 9) = Val(mf1.TextMatrix(mf1.Row, 7)) * Val(mf1.TextMatrix(mf1.Row, 8))
 mf1.TextMatrix(i, 9) = Format(mf1.TextMatrix(i, 9), "#0.00")
End If
Next i
End Sub
Private Sub kh_KeyDown(KeyCode As Integer, Shift As Integer)
 If KeyCode = vbKeyReturn Then jsr.SetFocus     '按回车键jsr获得焦点
 If KeyCode = vbKeyPageDown Then     '按PageDown键时
    DBList1.Visible = True
    DBList1.ReFill     '显示所有数据
    DBList1.SetFocus
 End If
End Sub
Private Sub kh_Change()
 DBList1.Visible = True
 DBList1.ReFill
 '查询客户信息
 Data2.RecordSource = "select 客户全称 from kh where ((kh.客户全称  like " + Chr(34) + kh.Text + "*" + Chr(34) + ")or (kh.简称 like " + Chr(34) + kh.Text + "*" + Chr(34) + "))group by 客户全称"
 Data2.Refresh
End Sub
Private Sub jsr_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then     '按回车键时
 Text1.Visible = True
 mf1.Row = 1: mf1.Col = 1     '到达mf1表格的第1行，第1列
 Text1.SetFocus
End If
If KeyCode = vbKeyUp Then kh.SetFocus     '按向上键kh获得焦点
End Sub
Private Sub dblist1_KeyPress(KeyAscii As Integer)
 DBList1.Visible = True
 kh.Text = DBList1.BoundText     '赋值给kh.text
 DBList1.Visible = False
 jsr.SetFocus
End Sub
Private Sub grid1_KeyDown(KeyCode As Integer, Shift As Integer)
 If KeyCode = vbKeyReturn Then
 With Data1.Recordset
 If Data1.Recordset.RecordCount > 0 Then
  If Data1.Recordset.Fields("商品名称") <> "" Then
   '赋值给mf1表格
   If .Fields("商品名称") <> "" Then mf1.TextMatrix(mf1.Row, 1) = .Fields("商品名称")
   If .Fields("批号") <> "" Then mf1.TextMatrix(mf1.Row, 2) = .Fields("批号")
   If .Fields("产地") <> "" Then mf1.TextMatrix(mf1.Row, 3) = .Fields("产地")
   If .Fields("规格") <> "" Then mf1.TextMatrix(mf1.Row, 4) = .Fields("规格")
   If .Fields("包装") <> "" Then mf1.TextMatrix(mf1.Row, 5) = .Fields("包装")
   If .Fields("单位") <> "" Then mf1.TextMatrix(mf1.Row, 6) = .Fields("单位")
   If .Fields("进价") <> "" Then mf1.TextMatrix(mf1.Row, 8) = .Fields("进价")
   Text1.Text = mf1.Text     '赋值给text1
   Text1.SetFocus
   mf1.Col = 7
   grid1.Visible = False
  Else
   MsgBox ("无数据选择!!!")
  End If
 End If
 End With
 Text1.SetFocus
 End If
 If KeyCode = vbKeyEscape Then     '按ESC键
  grid1.Visible = False     'grid1不可见
  Text1.SetFocus
 End If
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
 frm_main.Text1.Text = "3"
 If KeyCode = vbKeyReturn Then
  grid1.Visible = False
  If mf1.Col = 1 Then
   With Data1.Recordset
   If .RecordCount > 0 Then
    '赋值给mf1
    If .Fields("商品名称") <> "" Then mf1.TextMatrix(mf1.Row, 1) = .Fields("商品名称")
    If .Fields("批号") <> "" Then mf1.TextMatrix(mf1.Row, 2) = .Fields("批号")
    If .Fields("产地") <> "" Then mf1.TextMatrix(mf1.Row, 3) = .Fields("产地")
    If .Fields("规格") <> "" Then mf1.TextMatrix(mf1.Row, 4) = .Fields("规格")
    If .Fields("包装") <> "" Then mf1.TextMatrix(mf1.Row, 5) = .Fields("包装")
    If .Fields("单位") <> "" Then mf1.TextMatrix(mf1.Row, 6) = .Fields("单位")
    If .Fields("进价") <> "" Then mf1.TextMatrix(mf1.Row, 8) = .Fields("进价")
    mf1.Col = 6
   End If
   End With
  End If
  Call frm_main.movereturn     '调用函数
 End If
 If KeyCode = vbKeyUp Then
  If mf1.Row > 1 Then mf1.Row = mf1.Row - 1
 End If
 If KeyCode = vbKeyDown And (mf1.TextMatrix(mf1.Row, 2)) <> "" Then
  If mf1.Row < 99 Then mf1.Row = mf1.Row + 1
 End If
 If KeyCode = vbKeyLeft Then Call frm_main.moveleft     '调用函数
 If KeyCode = vbKeyRight Then Call frm_main.moveright     '调用函数
 If KeyCode = vbKeyPageDown And mf1.Col = 1 Then
  '查询库存商品信息
  Data1.RecordSource = "select * from kc"
  Data1.Refresh
  grid1.Visible = True
  grid1.SetFocus
 End If
End Sub
Private Sub text1_Change()
 DBList1.Visible = False
 mf1.Text = Text1.Text     '赋值给mf1.text
 If mf1.Col = 1 Then
  '按简称和商品名称查询库存商品信息
  Data1.RecordSource = "select * from kc where ((kc.简称 like " + Chr(34) + Text1.Text + "*" + Chr(34) + ")or(kc.商品名称 like " + Chr(34) + Text1.Text + "*" + Chr(34) + "))"
  Data1.Refresh
  If Text1.Text = "" Then
    grid1.Visible = False
   Else
    If Data1.Recordset.RecordCount > 0 Then     '当记录大于零时
       grid1.Visible = True     'grid1可见
       Text1.SetFocus
    End If
  End If
 End If
 If mf1.Col = 7 Then mf1.TextMatrix(mf1.Row, 9) = Val(mf1.TextMatrix(mf1.Row, 7)) * Val(mf1.TextMatrix(mf1.Row, 8))
 If mf1.Col = 8 Then
  mf1.TextMatrix(mf1.Row, 9) = Val(mf1.TextMatrix(mf1.Row, 7)) * Val(mf1.TextMatrix(mf1.Row, 8))
  If mf1.TextMatrix(mf1.Row, 7) = "" Then
   MsgBox ("数量无,请重新输入!!!")
   mf1.Col = 7
   grid1.Visible = False
  End If
 End If
 If mf1.Col = 10 Then
   If mf1.TextMatrix(mf1.Row, 8) = "" Then
    MsgBox ("单价无,请重新输入!!!")
    mf1.Col = 8
    grid1.Visible = False
   End If
 End If
 Dim A, B As Single
 For i = 1 To 31
     A = Val(mf1.TextMatrix(i, 9)) + A: B = Val(mf1.TextMatrix(i, 7)) + B     '计算合计金额，合计数量
 If mf1.TextMatrix(i, 1) <> "" And mf1.TextMatrix(i, 7) <> "" Then js.Text = i
 Next i
 hj.Text = A: hjsl.Text = B
End Sub
Private Sub Comdj_Click()
 '查询所有销售数据,并按票号排序
 Data3.RecordSource = "select * from xsd order by 票号"
 Data3.Refresh
'创建销售票号
If Data3.Recordset.RecordCount > 0 Then
  If Not Data3.Recordset.EOF Then Data3.Recordset.MoveLast
  If Data3.Recordset.Fields("票号") <> "" Then
     lsph = Right(Trim(Data3.Recordset.Fields("票号")), 4) + 1
     PH.Text = Date & "xsd" & Format(lsph, "0000")
  End If
 Else
  PH.Text = Date & "xsd" & "0001"
 End If
 '设置控件有效或无效
 kh.Enabled = True: jsr.Enabled = True: js.Enabled = True: hjsl.Enabled = True: hj.Enabled = True
 Text1.Enabled = True: mf1.Enabled = True: Combc.Enabled = True: Comqx.Enabled = True: Comdj.Enabled = False
 '清空数据
 For i = 1 To 100
 For j = 1 To 10
     mf1.TextMatrix(i, j) = ""
 Next j
 Next i
 kh.SetFocus
 mf1.Row = 1: mf1.Col = 1
End Sub
Private Sub Combc_Click()
 Set mydb1 = Workspaces(0).OpenDatabase(App.Path & "\yyjxc.mdb")     '自动识别数据库路径
 Set rs1 = mydb1.OpenRecordset("xsd", dbOpenTable)
 '查询库存商品信息
 Data1.RecordSource = "SELECT * FROM KC"
 Data1.Refresh
 For i = 1 To 101
  If mf1.TextMatrix(i, 1) <> "" And mf1.TextMatrix(i, 7) <> "" Then
   '添加新记录到"kc"表中
   rs1.AddNew
   If mf1.TextMatrix(i, 1) <> "" Then rs1.Fields("商品名称") = mf1.TextMatrix(i, 1)
   If mf1.TextMatrix(i, 2) <> "" Then rs1.Fields("批号") = mf1.TextMatrix(i, 2)
   If mf1.TextMatrix(i, 3) <> "" Then rs1.Fields("产地") = mf1.TextMatrix(i, 3)
   If mf1.TextMatrix(i, 4) <> "" Then rs1.Fields("规格") = mf1.TextMatrix(i, 4)
   If mf1.TextMatrix(i, 5) <> "" Then rs1.Fields("包装") = mf1.TextMatrix(i, 5)
   If mf1.TextMatrix(i, 6) <> "" Then rs1.Fields("单位") = mf1.TextMatrix(i, 6)
   If mf1.TextMatrix(i, 7) <> "" Then rs1.Fields("数量") = mf1.TextMatrix(i, 7)
   If mf1.TextMatrix(i, 8) <> "" Then rs1.Fields("单价") = mf1.TextMatrix(i, 8)
   If mf1.TextMatrix(i, 9) <> "" Then rs1.Fields("金额") = mf1.TextMatrix(i, 9)
   If mf1.TextMatrix(i, 10) <> "" Then rs1.Fields("备注") = mf1.TextMatrix(i, 10)
   If kh.Text <> "" Then rs1.Fields("客户") = kh.Text
   If jsr.Text <> "" Then rs1.Fields("经手人") = jsr.Text
   If rq.Text <> "" Then rs1.Fields("日期") = rq.Text
   If PH.Text <> "" Then rs1.Fields("票号") = PH.Text
   rs1.Update
   '查找库存商品信息
   Data1.Recordset.FindFirst "商品名称 like " + Chr(34) + mf1.TextMatrix(i, 1) + Chr(34) + "and 批号 like " + Chr(34) + mf1.TextMatrix(i, 2) + Chr(34) + "and 产地 like " + Chr(34) + mf1.TextMatrix(i, 3) + Chr(34) + "and 规格 like " + Chr(34) + mf1.TextMatrix(i, 4) + Chr(34) + ""
   If Data1.Recordset.NoMatch Then
     Else
      '更新"kc"表中的"库存"及"库存金额"
      Data1.Recordset.Edit
      Data1.Recordset.Fields("库存") = Val(Data1.Recordset.Fields("库存")) - Val(mf1.TextMatrix(i, 7))
      Data1.Recordset.Fields("库存金额") = Val(Data1.Recordset.Fields("库存")) * Val(Data1.Recordset.Fields("进价"))
      Data1.UpdateRecord
   End If
  End If
 Next i
 rs1.Close: mydb1.Close
 '清空数据
 For i = 1 To 100
 For j = 1 To 10
     mf1.TextMatrix(i, j) = ""
 Next j
 Next i
 kh.Text = "": jsr.Text = "": js.Text = "": hjsl.Text = "": hj.Text = ""
 Text1.Visible = False: DBList1.Visible = False     '设置控件不可见
 Combc.Enabled = False: mf1.Enabled = False: Comdj.Enabled = True: Comqx.Enabled = False
End Sub
Private Sub Comqx_Click()     '取消操作
 kh.Text = "": jsr.Text = "": js.Text = "": hjsl.Text = "": hj.Text = ""
 For i = 1 To 100
 For j = 1 To 10
 mf1.TextMatrix(i, j) = ""
 Next j
 Next i
 kh.Enabled = False: jsr.Enabled = False: js.Enabled = False: hjsl.Enabled = False: hj.Enabled = False
 DBList1.Visible = False: Text1.Enabled = False: mf1.Enabled = False: Combc.Enabled = False: Comqx.Enabled = False
 Comdj.Enabled = True: Comdj.SetFocus
End Sub
Private Sub Comend_Click()
 frm_main.Enabled = True
 Unload Me
End Sub