main_rcyw_rkd.frm

珠宝为例

         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   330
      Left            =   5010
      TabIndex        =   22
      Top             =   90
      Width           =   1365
   End
End
Attribute VB_Name = "main_rcyw_rkd"
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"
  MS1.Rows = 32: MS1.Cols = 11         '定义ms1表格的行数、列数
  MS1.FixedRows = 1: MS1.FixedCols = 1 '定义ms1表格固定行、固定列
  s = Array("300", "900", "1350", "900", "900", "900", "900", "900", "900", "1200", "1500")
  y = Array("xh", "编号", "商品名称", "简称", "CT", "G", "数量", "进价", "销价", "金额", "备注")
  For i = 0 To 10
   MS1.ColWidth(i) = s(i): MS1.TextMatrix(0, i) = y(i) '定义ms1表格的列宽和标题
  Next i
  For i = 1 To 31
     MS1.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 dbgr1_KeyDown(KeyCode As Integer, Shift As Integer)
 If KeyCode = vbKeyReturn Then
  With Data1.Recordset
  If Data1.Recordset.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("进价")
     If .Fields("销价") <> "" Then MS1.TextMatrix(MS1.Row, 8) = .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 ms1_Click()
 dbgr1.Visible = False
 If MS1.Row >= 1 And MS1.TextMatrix(MS1.Row - 1, 8) <> "" Then
    text1.Visible = True
    text1.SetFocus
 End If
End Sub
Private Sub ms1_entercell()
 frm_main.text1.Text = "2"
 Call frm_main.entercell       '调用函数
End Sub
Private Sub gys_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyReturn Then
     jsr.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 gys.SetFocus
End Sub
Private Sub ms1_RowColChange()
' 将第7、8、9列格式化为金额
 For i = 1 To 31
 If MS1.TextMatrix(i, 2) <> "" Then
  MS1.TextMatrix(i, 7) = Format(MS1.TextMatrix(i, 7), "#0.00")
  MS1.TextMatrix(i, 8) = Format(MS1.TextMatrix(i, 8), "#0.00")
  MS1.TextMatrix(MS1.Row, 9) = Val(MS1.TextMatrix(MS1.Row, 6)) * Val(MS1.TextMatrix(MS1.Row, 7))
  MS1.TextMatrix(i, 9) = Format(MS1.TextMatrix(i, 9), "#0.00")
 End If
 Next i
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
 frm_main.text1.Text = "2"
 If KeyCode = vbKeyReturn Then
  dbgr1.Visible = False
  If MS1.Col = 1 Then
   With Data1.Recordset
   If .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 MS1.TextMatrix(MS1.Row, 8) = .Fields("销价")
     MS1.Col = 5
   End If
   End With
  End If
  Call 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 < 31 Then MS1.Row = MS1.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 MS1.Col = 1 Then
       Data1.RecordSource = "select * from kc"
       Data1.Refresh
       dbgr1.Visible = True
       dbgr1.SetFocus
    End If
 End If
End Sub
Private Sub text1_Change()
 MS1.Text = text1.Text
 If MS1.Col = 1 Then
  Data1.RecordSource = "select * from kc  where (kc.编号 LIKE " + Chr(34) + text1.Text + "*" + Chr(34) + ")"
  Data1.Refresh
  If text1.Text = "" Then
     dbgr1.Visible = False
   Else
    If Data1.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, 9) = 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, 9) = Val(MS1.TextMatrix(MS1.Row, 7)) * Val(MS1.TextMatrix(MS1.Row, 6))
 End If
 If MS1.Col = 9 Then
  MS1.TextMatrix(MS1.Row, 9) = 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, 9)) + 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: zsl.Text = b
End Sub
Private Sub Comdj_Click()
  Dim lsph As Integer
  '查询所有入库数据,并按票号排序
  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
  MS1.Enabled = True: gys.Enabled = True: jsr.Enabled = True: zsl.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 10
      MS1.TextMatrix(i, j) = ""
  Next j
  Next i
  MS1.Row = 1: MS1.Col = 1
  gys.SetFocus
End Sub
Private Sub Combc_Click()
 Set mydb1 = Workspaces(0).OpenDatabase(App.Path & "\zbjxc.mdb")
 Set rs1 = mydb1.OpenRecordset("rkd", dbOpenTable)
 Set rs2 = mydb1.OpenRecordset("kc", dbOpenTable)
 '查询全部总库库存信息
 Data2.RecordSource = "select * from kc"
 Data2.Refresh
 For i = 1 To 31
  If MS1.TextMatrix(i, 2) <> "" And MS1.TextMatrix(i, 6) <> "" Then
    '保存新增记录到"rkd"表中
    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("数量") = Val(MS1.TextMatrix(i, 6))
    If MS1.TextMatrix(i, 7) <> "" Then rs1.Fields("进价") = Val(MS1.TextMatrix(i, 7))
    If MS1.TextMatrix(i, 8) <> "" Then rs1.Fields("销价") = Val(MS1.TextMatrix(i, 8))
    If MS1.TextMatrix(i, 9) <> "" Then rs1.Fields("金额") = Val(MS1.TextMatrix(i, 9))
    If MS1.TextMatrix(i, 10) <> "" Then rs1.Fields("备注") = MS1.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
     '查找总库库存商品信息
    Data2.Recordset.FindFirst "商品名称 like " + Chr(34) + MS1.TextMatrix(i, 2) + Chr(34) + "and CT like " + Chr(34) + MS1.TextMatrix(i, 4) + Chr(34) + "and 编号 like " + Chr(34) + MS1.TextMatrix(i, 1) + Chr(34) + "and 简称 like " + Chr(34) + MS1.TextMatrix(i, 3) + Chr(34) + "and G like " + Chr(34) + MS1.TextMatrix(i, 5) + Chr(34) + "and 进价 = " & Val(MS1.TextMatrix(i, 7)) & ""
    Data2.Recordset.FindFirst "编号 like " + Chr(34) + MS1.TextMatrix(i, 1) + Chr(34) + ""
    If Data2.Recordset.NoMatch Then
     '保存新增记录到"kc"表中
     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)
     rs2.Update                  '更新数据
    Else
     '更新"kc"表中的库存及库存金额
     Data2.Recordset.Edit
     Data2.Recordset.Fields("库存") = Val(MS1.TextMatrix(i, 6)) + Val(Data2.Recordset.Fields("库存"))
     Data2.Recordset.Fields("库存金额") = Val(Data2.Recordset.Fields("库存")) * Val(Data2.Recordset.Fields("进价"))
     Data2.UpdateRecord
    End If
  End If
 Next i
 rs1.Close: mydb1.Close
 For i = 1 To 31
  For j = 1 To 10
   MS1.TextMatrix(i, j) = ""
  Next j
 Next i
 gys.Text = "": jsr.Text = "": js.Text = "": zsl.Text = "": hj.Text = ""
 MS1.Enabled = False: gys.Enabled = False: jsr.Enabled = False: zsl.Enabled = False: hj.Enabled = False
 text1.Visible = False: dbgr1.Visible = False: Combc.Enabled = False: Comqx.Enabled = False: Comdj.Enabled = True
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
 gys.Text = "": jsr.Text = "": js.Text = "": zsl.Text = "": hj.Text = "": MS1.Enabled = False: dbgr1.Visible = False
 Comdj.SetFocus
End Sub
Private Sub Comend_Click()
  frm_main.Enabled = True
  Unload Me
End Sub