main_rcyw_ckd.frm

珠宝为例

         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   330
      Left            =   5175
      TabIndex        =   25
      Top             =   105
      Width           =   1365
   End
   Begin VB.Label wfje 
      BackStyle       =   0  'Transparent
      ForeColor       =   &H00FF0000&
      Height          =   210
      Left            =   7980
      TabIndex        =   1
      Top             =   6000
      Visible         =   0   'False
      Width           =   1455
   End
End
Attribute VB_Name = "main_rcyw_ckd"
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 rs2 As Recordset
Private Sub Form_Load()
'自动识别数据库路径
  Data1.DatabaseName = App.Path & "\zbjxc.mdb"
  Data2.DatabaseName = App.Path & "\zbjxc.mdb"
  Data3.DatabaseName = App.Path & "\zbjxc.mdb"
  Data4.DatabaseName = App.Path & "\zbjxc.mdb"
  Data5.DatabaseName = App.Path & "\zbjxc.mdb"
'定义ms1的总行数、列数
  MS1.Rows = 32: MS1.Cols = 10
'定义ms1的固定行、列
  MS1.FixedRows = 1: MS1.FixedCols = 1
  s = Array("300", "900", "1500", "1200", "1200", "900", "900", "900", "1200", "1645")
  y = Array("xh", "编号", "商品名称", "简称", "CT", "G", "数量", "单价", "金额", "备注")
  For i = 0 To 9
   MS1.ColWidth(i) = s(i): MS1.TextMatrix(0, i) = y(i) '定义ms1表格的列宽和标题
  Next i
'定义ms1的列的序号
  For i = 1 To 31
      MS1.TextMatrix(i, 0) = i
  Next i
  rq.Text = Date        '初始化出库日期
End Sub
Private Sub dbgr1_KeyDown(KeyCode As Integer, Shift As Integer)
 If KeyCode = vbKeyReturn Then
  With Data2.Recordset
  If .RecordCount > 0 Then
   If .Fields("商品名称") <> "" Then
    '赋值给ms1
    If .Fields("编号") <> "" Then MS1.TextMatrix(MS1.Row, 1) = .Fields("编号")
    If .Fields("商品名称") <> "" Then MS1.TextMatrix(MS1.Row, 2) = .Fields("商品名称")
    If .Fields("简称") <> "" Then MS1.TextMatrix(MS1.Row, 3) = .Fields("简称")
    If .Fields("CT") <> "" Then MS1.TextMatrix(MS1.Row, 4) = .Fields("CT")
    If .Fields("G") <> "" Then MS1.TextMatrix(MS1.Row, 5) = .Fields("G")
    If .Fields("进价") <> "" Then MS1.TextMatrix(MS1.Row, 7) = .Fields("进价")
    text1.Text = MS1.Text        '赋值给text1
    text1.SetFocus
    MS1.Col = 6
    dbgr1.Visible = False
   Else
    MsgBox ("无数据选择!!!")
    dbgr1.Visible = False
    text1.SetFocus
   End If
  End If
  End With
   text1.SetFocus
 End If
 If KeyCode = vbKeyEscape Then
    dbgr1.Visible = False
    text1.SetFocus
 End If
End Sub
Private Sub md_Change()           '查询门店信息
  DBList1.Visible = True
  DBList1.ReFill
  Data4.RecordSource = "select 门店全称 from kh where ((kh.门店全称  like " + Chr(34) + md.Text + "*" + Chr(34) + ")or (kh.简称 like " + Chr(34) + md.Text + "*" + Chr(34) + "))group by 门店全称"
  Data4.Refresh
End Sub
Private Sub dblist1_KeyPress(KeyAscii As Integer)
  DBList1.Visible = True
  md.Text = DBList1.BoundText
  DBList1.Visible = False
  jsr.SetFocus
End Sub
Private Sub jsr_Change()
  DBList1.Visible = False
End Sub
Private Sub ms1_Click()
  dbgr1.Visible = False
  If MS1.Row > 1 And MS1.TextMatrix(MS1.Row - 1, 8) <> "" Then
     text1.Visible = True
     text1.SetFocus
  End If
  If MS1.Row = 1 Then
     text1.Visible = True
     text1.SetFocus
  End If
End Sub
Private Sub ms1_entercell()
 frm_main.text1.Text = "1"
 frm_main.entercell              '调用函数
End Sub
Private Sub md_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyReturn Then
     jsr.SetFocus
  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
     MS1.Row = 1: MS1.Col = 1
     text1.Visible = True
     text1.SetFocus
  End If
  If KeyCode = vbKeyUp Then md.SetFocus
End Sub
Private Sub ms1_RowColChange()
' 将第7、8列格式化为金额
 For i = 1 To 31
 If MS1.TextMatrix(i, 2) <> "" Then
  MS1.TextMatrix(i, 7) = Format(MS1.TextMatrix(i, 7), "#0.00")
  MS1.TextMatrix(MS1.Row, 8) = Val(MS1.TextMatrix(MS1.Row, 6)) * Val(MS1.TextMatrix(MS1.Row, 7))
  MS1.TextMatrix(i, 8) = Format(MS1.TextMatrix(i, 8), "#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
  dbgr1.Visible = False
  If MS1.Col = 1 Then
   With Data2.Recordset
   If Data2.Recordset.RecordCount > 0 Then
    '赋值给ms1
    If .Fields("编号") <> "" Then MS1.TextMatrix(MS1.Row, 1) = .Fields("编号")
    If .Fields("商品名称") <> "" Then MS1.TextMatrix(MS1.Row, 2) = .Fields("商品名称")
    If .Fields("简称") <> "" Then MS1.TextMatrix(MS1.Row, 3) = .Fields("简称")
    If .Fields("CT") <> "" Then MS1.TextMatrix(MS1.Row, 4) = .Fields("CT")
    If .Fields("G") <> "" Then MS1.TextMatrix(MS1.Row, 5) = .Fields("G")
    If .Fields("进价") <> "" Then MS1.TextMatrix(MS1.Row, 7) = .Fields("进价")
    If .Fields("进价") <> "" Then ckjj.Text = .Fields("进价")
    MS1.Col = 5
   End If
   End With
  End If
  frm_main.movereturn
 End If
 If KeyCode = vbKeyUp Then
    If MS1.Row > 1 Then MS1.Row = MS1.Row - 1
 End If
 If KeyCode = vbKeyDown And (MS1.TextMatrix(MS1.Row, 2)) <> "" Then
    If MS1.Row < 99 Then MS1.Row = MS1.Row + 1
 End If
 If KeyCode = vbKeyLeft Then frm_main.moveleft
 If KeyCode = vbKeyRight Then frm_main.moveright
 If KeyCode = vbKeyPageDown Then
    If MS1.Col = 1 Then
       Data2.RecordSource = "select * from kc"
       Data2.Refresh
       dbgr1.Visible = True
       dbgr1.SetFocus
    End If
 End If
End Sub
Private Sub text1_Change()
 DBList1.Visible = False
 MS1.Text = text1.Text
  If MS1.Col = 1 Then
     Data2.RecordSource = "select * from kc  where (kc.编号 LIKE " + Chr(34) + text1.Text + "*" + Chr(34) + ")"
     Data2.Refresh
     If text1.Text = "" Then
        dbgr1.Visible = False
      Else
        If Data2.Recordset.RecordCount > 0 Then
           dbgr1.Visible = True
           text1.SetFocus
        End If
     End If
  End If
  If MS1.Col = 6 Then
     dbgr1.Visible = False
     MS1.TextMatrix(MS1.Row, 8) = Val(MS1.TextMatrix(MS1.Row, 7)) * Val(MS1.TextMatrix(MS1.Row, 6))
  End If
  If MS1.Col = 7 Then
     dbgr1.Visible = False
     MS1.TextMatrix(MS1.Row, 8) = Val(MS1.TextMatrix(MS1.Row, 7)) * Val(MS1.TextMatrix(MS1.Row, 6))
     If MS1.TextMatrix(MS1.Row, 6) = "" Then
        MsgBox ("数量无,请重新输入!!!")
        MS1.Col = 6
     End If
  End If
  If MS1.Col = 8 Then
     MS1.TextMatrix(MS1.Row, 8) = Val(MS1.TextMatrix(MS1.Row, 5)) * Val(MS1.TextMatrix(MS1.Row, 6))
     dbgr1.Visible = False
  End If
  Dim a, b, c As Single
  For i = 1 To 31
      a = Val(MS1.TextMatrix(i, 8)) + a              '计算总金额
      b = Val(MS1.TextMatrix(i, 6)) + b              '计算总数量
  If MS1.TextMatrix(i, 2) <> "" And MS1.TextMatrix(i, 6) <> "" Then js.Text = i
  Next i
  hj.Text = a: ckzs.Text = b
End Sub
Private Sub Form_Unload(Cancel As Integer)
  frm_main.Enabled = True
End Sub
Private Sub Comdj_Click()
  Dim lsph As Integer
  '查询所有出库数据,并按票号排序
  Data3.RecordSource = "select * from  ckd  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 & "ckd" & Format(lsph, "0000")
     End If
   Else
     PH.Text = Date & "ckd" & "0001"
  End If
  MS1.Enabled = True: md.Enabled = True: jsr.Enabled = True: ckzs.Enabled = True: hj.Enabled = True
  text1.Enabled = True: Combc.Enabled = True: Comqx.Enabled = True: Comdj.Enabled = False
  For i = 1 To 31
  For j = 1 To 9
   MS1.TextMatrix(i, j) = ""
  Next j
  Next i
  MS1.Row = 1: MS1.Col = 1: md.SetFocus
End Sub
Private Sub Combc_Click()
'保存出库信息、门店库存信息
 Set mydb1 = Workspaces(0).OpenDatabase(App.Path & "\zbjxc.mdb")
 Set rs1 = mydb1.OpenRecordset("mdkc", dbOpenTable)
 Set rs2 = mydb1.OpenRecordset("ckd", dbOpenTable)
 '查询全部总库库存信息
 Data2.RecordSource = "select * from kc"
 Data2.Refresh
 '查询门店库存信息
 Data5.RecordSource = "select * from mdkc"
 Data5.Refresh
 For i = 1 To 31
 If MS1.TextMatrix(i, 2) <> "" And MS1.TextMatrix(i, 6) <> "" Then
  '保存新增记录到"ckd"表中
  rs2.AddNew
  If MS1.TextMatrix(i, 1) <> "" Then rs2.Fields("编号") = MS1.TextMatrix(i, 1)
  If MS1.TextMatrix(i, 2) <> "" Then rs2.Fields("商品名称") = MS1.TextMatrix(i, 2)
  If MS1.TextMatrix(i, 3) <> "" Then rs2.Fields("简称") = MS1.TextMatrix(i, 3)
  If MS1.TextMatrix(i, 4) <> "" Then rs2.Fields("CT") = MS1.TextMatrix(i, 4)
  If MS1.TextMatrix(i, 5) <> "" Then rs2.Fields("G") = MS1.TextMatrix(i, 5)
  If MS1.TextMatrix(i, 6) <> "" Then rs2.Fields("库存") = MS1.TextMatrix(i, 6)
  If MS1.TextMatrix(i, 7) <> "" Then rs2.Fields("单价") = MS1.TextMatrix(i, 7)
  If MS1.TextMatrix(i, 8) <> "" Then rs2.Fields("金额") = MS1.TextMatrix(i, 8)
  If MS1.TextMatrix(i, 9) <> "" Then rs2.Fields("备注") = MS1.TextMatrix(i, 9)
  If md.Text <> "" Then rs2.Fields("门店名称") = md.Text
  If jsr.Text <> "" Then rs2.Fields("经手人") = jsr.Text
  If rq.Text <> "" Then rs2.Fields("日期") = rq.Text
  If PH.Text <> "" Then rs2.Fields("票号") = PH.Text
  '更新数据
  rs2.Update
  '查找门店库存信息
  Data5.Recordset.FindFirst "商品名称 like " + Chr(34) + MS1.TextMatrix(i, 2) + Chr(34) + "and  G like " + Chr(34) + MS1.TextMatrix(i, 5) + Chr(34) + "and 编号 like " + Chr(34) + MS1.TextMatrix(i, 1) + Chr(34) + "and 简称 like " + Chr(34) + MS1.TextMatrix(i, 3) + Chr(34) + "and CT like " + Chr(34) + MS1.TextMatrix(i, 4) + Chr(34) + "and  门店名称 like " + Chr(34) + md.Text + Chr(34) + "and 单价 = " & Val(MS1.TextMatrix(i, 7)) & ""
  If Data5.Recordset.NoMatch Then
   '保存新增记录到"mdkc"表中
   rs1.AddNew
   If MS1.TextMatrix(i, 1) <> "" Then rs1.Fields("编号") = MS1.TextMatrix(i, 1)
   If MS1.TextMatrix(i, 2) <> "" Then rs1.Fields("商品名称") = MS1.TextMatrix(i, 2)
   If MS1.TextMatrix(i, 3) <> "" Then rs1.Fields("简称") = MS1.TextMatrix(i, 3)
   If MS1.TextMatrix(i, 4) <> "" Then rs1.Fields("CT") = MS1.TextMatrix(i, 4)
   If MS1.TextMatrix(i, 5) <> "" Then rs1.Fields("G") = MS1.TextMatrix(i, 5)
   If MS1.TextMatrix(i, 6) <> "" Then rs1.Fields("库存") = MS1.TextMatrix(i, 6)
   If MS1.TextMatrix(i, 7) <> "" Then rs1.Fields("单价") = MS1.TextMatrix(i, 7)
   If MS1.TextMatrix(i, 8) <> "" Then rs1.Fields("金额") = MS1.TextMatrix(i, 8)
   If md.Text <> "" Then rs1.Fields("门店名称") = md.Text
   rs1.Update
   Else
    '更新"mdkc"表中的库存及金额
    Data5.Recordset.Edit
    Data5.Recordset.Fields("库存") = Val(Data5.Recordset.Fields("库存")) + Val(MS1.TextMatrix(i, 6))
    Data5.Recordset.Fields("金额") = Val(Data5.Recordset.Fields("单价")) * Val(Data5.Recordset.Fields("库存"))
    Data5.UpdateRecord
  End If
  '查找总库库存信息
  Data2.Recordset.FindFirst "商品名称 like " + Chr(34) + MS1.TextMatrix(i, 2) + Chr(34) + "and 简称 like " + Chr(34) + MS1.TextMatrix(i, 3) + Chr(34) + "and  G like " + Chr(34) + MS1.TextMatrix(i, 5) + Chr(34) + "and CT like " + Chr(34) + MS1.TextMatrix(i, 4) + Chr(34) + "and 编号 like " + Chr(34) + MS1.TextMatrix(i, 1) + Chr(34) + "and 进价 =" & Val(MS1.TextMatrix(i, 7)) & ""
  If Data2.Recordset.NoMatch Then
   Else
     '更新"kc"表中的库存及库存金额
    Data2.Recordset.Edit
    Data2.Recordset.Fields("库存") = Val(Data2.Recordset.Fields("库存")) - Val(MS1.TextMatrix(i, 6))
    Data2.Recordset.Fields("库存金额") = Val(Data2.Recordset.Fields("进价")) * Val(Data2.Recordset.Fields("库存"))
    Data2.UpdateRecord
  End If
 End If
 Next i
 rs1.Close: mydb1.Close
 md.Text = "": jsr.Text = "": js.Text = "": ckzs.Text = "": hj.Text = ""
 MS1.Enabled = False: md.Enabled = False: jsr.Enabled = False: ckzs.Enabled = False: hj.Enabled = False
 text1.Visible = False: Combc.Enabled = False: Comqx.Enabled = False: Comdj.Enabled = True
 DBList1.Visible = False: dbgr1.Visible = False
End Sub
Private Sub Comqx_Click()      '取消操作
 text1.Visible = False: Combc.Enabled = False: Comqx.Enabled = False: Comdj.Enabled = True
 For i = 1 To 31
 For j = 1 To 9
 MS1.TextMatrix(i, j) = ""
 Next j
 Next i
 MS1.Row = 1: MS1.Col = 1
 md.Text = "": jsr.Text = "": js.Text = "": ckzs.Text = "": hj.Text = ""
 MS1.Enabled = False: DBList1.Visible = False: dbgr1.Visible = False
 Comdj.SetFocus
End Sub
Private Sub Comend_Click()
  frm_main.Enabled = True
  Unload Me
End Sub