main_rcyw_rktd.frm

简单的进销存vb源代码

      Caption         =   "入 库 退 单"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   285
      Left            =   4740
      TabIndex        =   23
      Top             =   90
      Width           =   1815
   End
End
Attribute VB_Name = "main_rcyw_rktd"
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", "750", "750", "900", "1200", "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 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 .RecordCount > 0 Then     '当记录大于零时
     If .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     '到达mf1表格的第7列
        grid1.Visible = False
      Else
        MsgBox ("无数据选择!!!")
        grid1.Visible = False
        text1.SetFocus
     End If
  End If
  End With
  text1.SetFocus     'text1获得焦点
 End If
 If KeyCode = vbKeyEscape Then     '按ESC键
    grid1.Visible = False     'grid1不可见
    text1.SetFocus
 End If
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 = "2"
 Call frm_main.entercell     '调用函数
End Sub
Private Sub mf1_RowColChange()     '格式化金额
 For i = 1 To 100
  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, 8)) * Val(mf1.TextMatrix(mf1.Row, 7))
   mf1.TextMatrix(i, 9) = Format(mf1.TextMatrix(i, 9), "#0.00")
  End If
 Next i
End Sub
Private Sub gys_KeyDown(KeyCode As Integer, Shift As Integer)
 If KeyCode = vbKeyReturn Then     '按回车键jsr获得焦点
    jsr.SetFocus
    DBList1.Visible = False
 End If
 If KeyCode = vbKeyPageDown Then
    DBList1.Visible = True
    DBList1.ReFill
    DBList1.SetFocus
 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
     text1.Visible = True: text1.SetFocus
  End If
  If KeyCode = vbKeyUp Then gys.SetFocus
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
 frm_main.text1.Text = "2"
 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 Then
  If mf1.Col = 1 Then
    '查询库存商品
    Data1.RecordSource = "select * from kc"
    Data1.Refresh
    grid1.Visible = True
    grid1.SetFocus
  End If
 End If
End Sub
Private Sub text1_Change()
  DBList1.Visible = False
  mf1.Text = text1.Text     '赋值给mf1
  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  rktd  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 & "rktd" & Format(lsph, "0000")
     End If
   Else
     PH.Text = Date & "rktd" & "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 10
      mf1.TextMatrix(i, j) = ""
  Next j
  Next i
  gys.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("rktd", dbOpenTable)
  '查询库存信息
  Data1.RecordSource = "SELECT * FROM KC"
  Data1.Refresh
  For i = 1 To 100
   If mf1.TextMatrix(i, 1) <> "" And mf1.TextMatrix(i, 7) <> "" Then
    '添加数据到"rktd"表中
    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 gys.Text <> "" Then rs1.Fields("供应商") = gys.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
  gys.Text = "": jsr.Text = "": js.Text = "": hjsl.Text = "": hj.Text = ""
  text1.Visible = False: DBList1.Visible = 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 10
      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