main_rcyw_rk.frm

简单的进销存vb源代码

      Height          =   285
      Left            =   5010
      TabIndex        =   12
      Top             =   90
      Width           =   1395
   End
   Begin VB.Line Line1 
      X1              =   5355
      X2              =   6555
      Y1              =   2730
      Y2              =   3210
   End
End
Attribute VB_Name = "main_rcyw_rk"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim s, y, i     '定义变量
Dim mydb As Database     '定义数据库
Dim rs1 As Recordset     '定义字段
Dim rs2 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 = 12     '定义mf1表的总行数、总列数
'定义mf1表的列宽和表头信息
 s = Array("300", "1500", "900", "1200", "900", "1200", "600", "600", "600", "900", "1140", "850")
 y = Array("xh", "商品名称", "简称", "批号", "厂家", "规格", "包装", "单位", "数量", "单价", "金额", "备注")
 For i = 0 To 11
  mf1.ColWidth(i) = s(i): mf1.TextMatrix(0, i) = y(i)
 Next i
 mf1.FixedRows = 1: mf1.FixedCols = 1     '定义mf1表的固定行数、固定列数
 '定义mf1表的列序号
 For i = 1 To 101
     mf1.TextMatrix(i, 0) = i
 Next i
 rkrq.Text = Date     '设置入库日期
End Sub
Private Sub Form_Unload(Cancel As Integer)
  frm_main.Enabled = True
End Sub
Private Sub gys_Change()
 DBList1.Visible = True
 DBList1.ReFill
 '查询供应商信息
 Data2.RecordSource = "select 供应商全称 from gys where ((gys.供应商全称  like " + Chr(34) + gys.Text + "*" + Chr(34) + ")or (gys.简称 like " + Chr(34) + gys.Text + "*" + Chr(34) + "))group by 供应商全称"
 Data2.Refresh
End Sub
Private Sub dblist1_KeyPress(KeyAscii As Integer)
 DBList1.Visible = True
 gys.Text = DBList1.BoundText     '赋值给gys.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, 7) = .Fields("单位")
   If .Fields("进价") <> "" Then mf1.TextMatrix(mf1.Row, 9) = .Fields("进价")
   text1.Text = mf1.Text        '赋值给text1
   text1.SetFocus
   mf1.Col = 8     '到达第8列
   grid1.Visible = False
 Else
   MsgBox ("无数据选择!!!")
   grid1.Visible = False     'grid1不可见
   text1.SetFocus
  End If
 End If
 End With
 text1.SetFocus     'text1获得焦点
End If
If KeyCode = vbKeyEscape Then     '按ESC键
  grid1.Visible = False     'grid1不可见
  text1.SetFocus     'text1获得焦点
End If
End Sub
Private Sub gys_KeyDown(KeyCode As Integer, Shift As Integer)
 If KeyCode = vbKeyReturn Then     '按回车键
    jsr.SetFocus     'jsr获得焦点
    DBList1.Visible = False     'DBList1不可见
 End If
 If KeyCode = vbKeyPageDown Then     '按PageDown键
    DBList1.Visible = True     'DBList1可见
    DBList1.ReFill
    DBList1.SetFocus     'DBList1获得焦点
 End If
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     '到达第1行，第1列
 text1.SetFocus
End If
If KeyCode = vbKeyUp Then gys.SetFocus     '按向上键gys获得焦点
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 = "1"
 Call frm_main.entercell     '调用函数
End Sub
Private Sub mf1_RowColChange()     '格式化金额
  For i = 1 To 100
   If mf1.TextMatrix(i, 1) <> "" Then
    mf1.TextMatrix(i, 9) = Format(mf1.TextMatrix(i, 9), "#0.000")
    mf1.TextMatrix(mf1.Row, 10) = Val(mf1.TextMatrix(mf1.Row, 9)) * Val(mf1.TextMatrix(mf1.Row, 8))
    mf1.TextMatrix(i, 10) = Format(mf1.TextMatrix(i, 10), "#0.00")
   End If
  Next i
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
  frm_main.text1.Text = "1"
  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, 7) = .Fields("单位")
           If .Fields("进价") <> "" Then mf1.TextMatrix(mf1.Row, 9) = .Fields("进价")
           mf1.Col = 7
        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     '当text1.text为空时
     grid1.Visible = False     'grid1不可见
   Else
     If Data1.Recordset.RecordCount > 0 Then     '当记录大于零时
        grid1.Visible = True     'grid1可见
        text1.SetFocus
     End If
  End If
 End If
 If mf1.Col = 8 Then mf1.TextMatrix(mf1.Row, 10) = Val(mf1.TextMatrix(mf1.Row, 8)) * Val(mf1.TextMatrix(mf1.Row, 9))
 If mf1.Col = 9 Then
  mf1.TextMatrix(mf1.Row, 10) = Val(mf1.TextMatrix(mf1.Row, 8)) * Val(mf1.TextMatrix(mf1.Row, 9))
  If mf1.TextMatrix(mf1.Row, 8) = "" Then
     MsgBox ("数量无,请重新输入!!!")
     mf1.Col = 8
     grid1.Visible = False
  End If
 End If
 If mf1.Col = 11 Then
  If mf1.TextMatrix(mf1.Row, 9) = "" Then
     MsgBox ("单价无,请重新输入!!!")
     mf1.Col = 9
     grid1.Visible = False
  End If
 End If
 Dim A, B As Single
 For i = 1 To 31
   A = Val(mf1.TextMatrix(i, 10)) + A: B = Val(mf1.TextMatrix(i, 8)) + B
 If mf1.TextMatrix(i, 1) <> "" And mf1.TextMatrix(i, 8) <> "" Then js.Text = i
 Next i
 hj.Text = A: hjsl.Text = B     '计算合计金额，合计数量
End Sub
Private Sub Comdj_Click()
'查询所有入库数据,并按票号排序
Data3.RecordSource = "select * from  rkd  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 & "rkd" & Format(lsph, "0000")
 End If
 Else
   PH.Text = Date & "rkd" & "0001"
End If
'设置控件有效或无效
gys.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 11
    mf1.TextMatrix(i, j) = ""
Next j
Next i
gys.SetFocus
mf1.Row = 1: mf1.Col = 1    '到达mf1表格的第1行，第1列
End Sub
Private Sub Combc_Click()
 Set mydb = Workspaces(0).OpenDatabase(App.Path & "\yyjxc.mdb")     '自动识别数据库路径
 Set rs1 = mydb.OpenRecordset("rkd", dbOpenTable)
 Set rs2 = mydb.OpenRecordset("kc", dbOpenTable)
 '查询库存商品信息
 Data1.RecordSource = "SELECT * FROM KC"
 Data1.Refresh
 For i = 1 To 100
  If mf1.TextMatrix(i, 1) <> "" And mf1.TextMatrix(i, 8) <> "" Then
   '添加入库商品信息到"rkd"表中
   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 mf1.TextMatrix(i, 11) <> "" Then rs1.Fields("备注") = mf1.TextMatrix(i, 11)
   If gys.Text <> "" Then rs1.Fields("供应商") = gys.Text
   If jsr.Text <> "" Then rs1.Fields("经手人") = jsr.Text
   If rkrq.Text <> "" Then rs1.Fields("日期") = rkrq.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, 3) + Chr(34) + "and 产地 like " + Chr(34) + mf1.TextMatrix(i, 4) + Chr(34) + " and 规格 like " + Chr(34) + mf1.TextMatrix(i, 5) + Chr(34) + ""
   If Data1.Recordset.NoMatch Then
   '添加入库商品到"kc"表中
    rs2.AddNew
    If mf1.TextMatrix(i, 1) <> "" Then rs2.Fields("商品名称") = mf1.TextMatrix(i, 1)
    If mf1.TextMatrix(i, 2) <> "" Then rs2.Fields("简称") = mf1.TextMatrix(i, 2)
    If mf1.TextMatrix(i, 3) <> "" Then rs2.Fields("批号") = mf1.TextMatrix(i, 3)
    If mf1.TextMatrix(i, 4) <> "" Then rs2.Fields("产地") = mf1.TextMatrix(i, 4)
    If mf1.TextMatrix(i, 5) <> "" Then rs2.Fields("规格") = mf1.TextMatrix(i, 5)
    If mf1.TextMatrix(i, 6) <> "" Then rs2.Fields("包装") = mf1.TextMatrix(i, 6)
    If mf1.TextMatrix(i, 7) <> "" Then rs2.Fields("单位") = mf1.TextMatrix(i, 7)
    If mf1.TextMatrix(i, 8) <> "" Then rs2.Fields("库存") = mf1.TextMatrix(i, 8)
    If mf1.TextMatrix(i, 9) <> "" Then rs2.Fields("进价") = mf1.TextMatrix(i, 9)
    If mf1.TextMatrix(i, 10) <> "" Then rs2.Fields("库存金额") = mf1.TextMatrix(i, 10)
    rs2.Update     '更新表
  Else
    '更新"kc"表中的"库存"及"库存金额"
    Data1.Recordset.Edit
    Data1.Recordset.Fields("库存") = Val(mf1.TextMatrix(i, 8)) + Val(Data1.Recordset.Fields("库存"))
    Data1.Recordset.Fields("库存金额") = Val(Data1.Recordset.Fields("库存")) * Val(Data1.Recordset.Fields("进价"))
    Data1.UpdateRecord
   End If
  End If
 Next i
 rs1.Close: mydb.Close
 '清空数据
 For i = 1 To 100
 For j = 1 To 11
     mf1.TextMatrix(i, j) = ""
 Next j
 Next i
 gys.Text = "": jsr.Text = "": js.Text = "": hjsl.Text = "": hj.Text = ""
 text1.Visible = False: DBList1.Visible = False     '设置控件不可见
 mf1.Enabled = False: Combc.Enabled = False: Comdj.Enabled = True: Comqx.Enabled = False
End Sub
Private Sub Comqx_Click()      '取消操作
 gys.Text = "": jsr.Text = "": js.Text = "": hjsl.Text = "": hj.Text = ""
 For i = 1 To 100
 For j = 1 To 11
 mf1.TextMatrix(i, j) = ""
 Next j
 Next i
 gys.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