main_rcyw_rk.frm

钢材综合管理系统 钢材综合管理系统

 Me.Caption = Me.Caption & "     操作员： " & frm_main.St1.Panels(3).Text
End Sub
Private Sub Form_Load()
 MS1.Rows = 102: MS1.Cols = 9     '定义MS1表的总行数、总列数
 '定义MS1表格的列宽及表头
 s = Array("300", "2100", "1200", "1800", "1500", "765", "1200", "1200", "1200")
 y = Array("xh", "商品名称", "商品编号", "规格", "产地", "单位", "进价", "数量", "金额")
 For i = 0 To 8
  MS1.ColWidth(i) = s(i): MS1.TextMatrix(0, i) = y(i)
 Next i
 MS1.FixedRows = 1: MS1.FixedCols = 1    '设置固定行、列
 '定义MS1表的列序号
 For i = 1 To 101
  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 ck_Change()
  ck.Text = Trim(ck.BoundText)
End Sub
Private Sub ck_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyReturn Then     '按回车键焦点到MS1表格的第一行第一列中
     MS1.Row = 1: MS1.Col = 1
     Text1.Visible = True     'text1输入框可见并获得焦点
     Text1.SetFocus     'text1获得焦点
  End If
End Sub
Private Sub gys_Change()
 DataList1.ReFill     '显示所有记录
 Adodc1.RecordSource = "select * from gys where 供应商全称 like '" + Trim(gys.Text) + "'+ '%'or 简称 like '" + Trim(gys.Text) + "'+ '%'"
 Adodc1.Refresh
 If gys.Text <> "" And Adodc1.Recordset.RecordCount > 0 Then DataList1.Visible = True
End Sub
Private Sub gys_KeyDown(KeyCode As Integer, Shift As Integer)
 If KeyCode = vbKeyReturn Then    '按回车键DataList1不可见
  DataList1.Visible = False
  jsr.SetFocus
 End If
 If KeyCode = vbKeyPageDown Then  '按PageDown键，datalist1显示所有记录
  DataList1.ReFill
  DataList1.Visible = True
  DataList1.SetFocus
 End If
End Sub
Private Sub grid1_KeyDown(KeyCode As Integer, Shift As Integer)
 If KeyCode = vbKeyReturn Then
  With Adodc2.Recordset
  If .RecordCount > 0 Then     '当记录大于零时
   If .Fields("商品名称") <> "" Then
    '赋值给MS1表格
    If .Fields("商品名称") <> "" Then MS1.TextMatrix(MS1.Row, 1) = Trim(.Fields("商品名称"))
    If .Fields("商品编号") <> "" Then MS1.TextMatrix(MS1.Row, 2) = Trim(.Fields("商品编号"))
    If .Fields("规格") <> "" Then MS1.TextMatrix(MS1.Row, 3) = Trim(.Fields("规格"))
    If .Fields("产地") <> "" Then MS1.TextMatrix(MS1.Row, 4) = Trim(.Fields("产地"))
    If .Fields("单位") <> "" Then MS1.TextMatrix(MS1.Row, 5) = Trim(.Fields("单位"))
    If .Fields("进价") <> "" Then MS1.TextMatrix(MS1.Row, 6) = .Fields("进价")
    Text1.Text = MS1.Text     '赋值给text1
    Text1.SetFocus
    MS1.Col = 6
    grid1.Visible = False
   Else
    MsgBox ("无数据选择!!!")
    grid1.Visible = False
    Text1.SetFocus
   End If
  End If
  End With
  Text1.SetFocus
 End If
 If KeyCode = vbKeyEscape Then     '按ESC键grid1不可见
  grid1.Visible = False
  Text1.SetFocus     'text1获得焦点
 End If
End Sub
Private Sub DataList1_KeyDown(KeyCode As Integer, Shift As Integer)
 If KeyCode = vbKeyReturn Then
  gys.Text = Trim(DataList1.BoundText)     '去除空格
  DataList1.Visible = False
 End If
End Sub
Private Sub jsr_Change()     '去除空格
 jsr.Text = Trim(jsr.BoundText)
End Sub
Private Sub jsr_KeyDown(KeyCode As Integer, Shift As Integer)
 If KeyCode = vbKeyReturn Then ck.SetFocus     '按回车键ck获得焦点
End Sub
Private Sub MS1_Click()     '单击MS1表格
 If MS1.Row >= 1 And MS1.TextMatrix(MS1.Row - 1, 7) <> "" Then
  Text1.Visible = True
  Text1.SetFocus
 End If
End Sub
Private Sub MS1_entercell()    '确定text1在MS1表格中的位置
 Dim X As String, y As String, p As String
 If MS1.CellWidth <= 0 Or MS1.CellHeight <= 0 Then Exit Sub
 X = MS1.TextMatrix(MS1.FixedRows, MS1.Col): y = MS1.TextMatrix(MS1.Row, 0)
 If y <> "" Then
  If MS1.Col - MS1.LeftCol <= 3 Then MS1.LeftCol = MS1.LeftCol + 1
  If MS1.CellWidth > 0 And MS1.CellHeight > 0 Then
   Text1.Width = MS1.CellWidth: Text1.Height = MS1.CellHeight
   Text1.Left = MS1.CellLeft + MS1.Left: Text1.Top = MS1.CellTop + MS1.Top
  End If
  X = MS1.TextMatrix(MS1.FixedRows, MS1.Col): y = MS1.TextMatrix(MS1.Row, 0)
  p = MS1.TextMatrix(MS1.Row, MS1.Col)
  Text1.Text = MS1.Text     '赋值给text1.text
  Text1.SelStart = 0
  Text1.SelLength = Len(Text1.Text)
 End If
End Sub
Private Sub MS1_RowColChange()     '格式化MS1表的第6列、第8列
 For i = 1 To 101
  If MS1.TextMatrix(i, 1) <> "" Then
   MS1.TextMatrix(MS1.Row, 6) = Format(MS1.TextMatrix(MS1.Row, 6), "#0.00")
   MS1.TextMatrix(MS1.Row, 8) = Val(MS1.TextMatrix(MS1.Row, 7)) * Val(MS1.TextMatrix(MS1.Row, 6))
   MS1.TextMatrix(MS1.Row, 8) = Format(MS1.TextMatrix(MS1.Row, 8), "#0.00")
  End If
 Next i
End Sub
Private Sub sf_Change()      '计算未付金额
  wf.Text = Format((Val(yfje.Text) - Val(sf.Text)), "0.00")
End Sub
Private Sub sl_Change()
 Call yfje_exp     '调用函数
End Sub
Private Sub sl_KeyDown(KeyCode As Integer, Shift As Integer)
 If KeyCode = vbKeyReturn Then Combo1.SetFocus
End Sub
Private Sub zk_Change()
 Call yfje_exp     '调用函数
End Sub
Private Sub zk_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyReturn Then sl.SetFocus
End Sub
Private Sub hjje_Change()
 Call yfje_exp     '调用函数
 wf.Text = Format((Val(yfje.Text) - Val(sf.Text)), "0.00")     '计算未付金额
End Sub
Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
 If KeyCode = vbKeyReturn Then sf.SetFocus
End Sub
Private Sub sf_KeyDown(KeyCode As Integer, Shift As Integer)
 If KeyCode = vbKeyReturn Then Combc.SetFocus     '按回车键combc获得焦点
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
 If KeyCode = vbKeyReturn Then
  If MS1.Col = 1 Then
   With Adodc2.Recordset
   If Adodc2.Recordset.RecordCount > 0 Then
     '赋值给MS1表格
      If .Fields("商品名称") <> "" Then MS1.TextMatrix(MS1.Row, 1) = Trim(.Fields("商品名称"))
      If .Fields("商品编号") <> "" Then MS1.TextMatrix(MS1.Row, 2) = Trim(.Fields("商品编号"))
      If .Fields("规格") <> "" Then MS1.TextMatrix(MS1.Row, 3) = Trim(.Fields("规格"))
      If .Fields("产地") <> "" Then MS1.TextMatrix(MS1.Row, 4) = Trim(.Fields("产地"))
      If .Fields("单位") <> "" Then MS1.TextMatrix(MS1.Row, 5) = Trim(.Fields("单位"))
      If .Fields("进价") <> "" Then MS1.TextMatrix(MS1.Row, 6) = .Fields("进价")
      Text1.SetFocus
      Text1.Text = MS1.Text     '赋值给text1.text
      grid1.Visible = False
      MS1.Col = 5
   End If
   End With
  End If
  If MS1.Col = 8 Then
     MS1.Row = MS1.Row + 1
     MS1.Col = 1
   Else
     If MS1.Col + 1 <= MS1.Cols - 1 Then
        MS1.Col = MS1.Col + 1
      Else
        If MS1.Row + 1 <= MS1.Rows - 1 Then
           MS1.Row = MS1.Row + 1
           MS1.Col = 1
        End If
     End If
  End If
 End If
 If KeyCode = vbKeyUp Then     'text1向上移动
    If MS1.Row > 1 Then MS1.Row = MS1.Row - 1
 End If
 If KeyCode = vbKeyDown Then
    If MS1.Row < 99 Then MS1.Row = MS1.Row + 1
 End If
 If KeyCode = vbKeyLeft Then     'text1向左移动
    If Text1.Text <> "" Then
       Text1.SelStart = 0
       Text1.SelLength = Len(Text1.Text)
    End If
    If MS1.Col - 8 <= MS1.Cols + 1 Then
       MS1.Col = MS1.Col - 1
       If MS1.Col = 0 Then MS1.Col = 1
      Else
       If MS1.Row + 1 <= MS1.Row - 1 Then
          MS1.Row = MS1.Row + 1
          MS1.Col = 1
       End If
    End If
 End If
 If KeyCode = vbKeyRight Then     'text1向右移动
    If Text1.Text <> "" Then
       Text1.SelStart = 0
       Text1.SelLength = Len(Text1.Text)
    End If
    If MS1.Col + 1 <= MS1.Cols - 1 Then
       MS1.Col = MS1.Col + 1
      Else
       If MS1.Row + 1 <= MS1.Rows - 1 Then
          MS1.Row = MS1.Row + 1
          MS1.Col = 1
       End If
    End If
 End If
 If KeyCode = vbKeyPageDown And MS1.Col = 1 Then
  Adodc2.RecordSource = "select * from spinf "
  Adodc2.Refresh     '查询商品信息
  grid1.Visible = True
  grid1.SetFocus
 End If
End Sub
Private Sub Text1_Change()
  MS1.Text = Text1.Text     '赋值给MS1表格
  If MS1.Col = 1 Then
   If Text1.Text = "" Then
      grid1.Visible = False
    Else
     '筛选商品名称或简称符合text1的记录
     Adodc2.RecordSource = "select * from spinf where (商品名称 like '" + Text1.Text + "'+ '%')or( 简称  like '" + Text1.Text + "'+'%')"
     Adodc2.Refresh
     If Adodc2.Recordset.RecordCount > 0 Then
        grid1.Visible = True
        Text1.SetFocus
     End If
   End If
  End If
  If MS1.Col = 3 Then
    If MS1.TextMatrix(MS1.Row, 1) = "" Then
      MsgBox ("无商品名称,请重新输入!!!")
      MS1.Col = 1
    End If
  End If
  If MS1.Col = 6 Then MS1.TextMatrix(MS1.Row, 8) = Val(MS1.TextMatrix(MS1.Row, 7)) * Val(MS1.TextMatrix(MS1.Row, 6))
  If MS1.Col = 7 Then MS1.TextMatrix(MS1.Row, 8) = Val(MS1.TextMatrix(MS1.Row, 7)) * Val(MS1.TextMatrix(MS1.Row, 6))
  Dim a, B As Single
  For i = 1 To 101
   If MS1.TextMatrix(i, 1) <> "" And MS1.TextMatrix(i, 7) <> "" Then
   pz.Text = i                                  '品种数
   a = Val(MS1.TextMatrix(i, 8)) + a    '求合计金额
   B = Val(MS1.TextMatrix(i, 7)) + B    '求合计数量
  End If
  Next i
  hjsl.Text = B: hjje.Text = Format(a, "0.00")
End Sub
Private Sub Comdj_Click()     '登记
 '确定文本框在MS1表格中的大小和位置
 Text1.Width = MS1.CellWidth: Text1.Height = MS1.CellHeight
 Text1.Left = MS1.CellLeft + MS1.Left: Text1.Top = MS1.CellTop + MS1.Top
 MS1.Enabled = True
 Dim lsph As Integer     '定义一个整型变量
 '创建入库票号
 rs2.Open "select * from rkd order by 票号", cnn, adOpenKeyset, adLockOptimistic
 If rs2.RecordCount > 0 Then
    If Not rs2.EOF Then rs2.MoveLast
    If rs2.Fields("票号") <> "" Then
       lsph = Right(Trim(rs2.Fields("票号")), 4) + 1
       ph.Text = Date & "rk" & Format(lsph, "0000")
    End If
  Else
    ph.Text = Date & "rk" & "0001"
 End If
 rs2.Close
 '设置控件可用或不可用状态
 gys.Enabled = True: sf.Enabled = True: Combc.Enabled = True
 Comqx.Enabled = True: Comdj.Enabled = False
 Text1.Enabled = True: sf.Enabled = True
 '清空数据
 For i = 1 To 100
 For j = 1 To 8
     MS1.TextMatrix(i, j) = ""
 Next j
 Next i
 gys.Text = "": pz.Text = "0": hjsl.Text = "0"
 hjje.Text = "0": sf.Text = "0": wf.Text = "0"
 gys.SetFocus
End Sub
Private Sub Combc_Click()     '保存
 rs3.Open "select * from rkd", cnn, adOpenKeyset, adLockOptimistic
 If MS1.TextMatrix(1, 1) <> "" And MS1.TextMatrix(1, 7) <> "" Then
  For i = 1 To 100
   If MS1.TextMatrix(i, 1) <> "" And MS1.TextMatrix(i, 7) <> "" Then
   '添加新记录到"rkd"表中
    rs3.AddNew
    If MS1.TextMatrix(i, 1) <> "" Then rs3.Fields("商品名称") = Trim(MS1.TextMatrix(i, 1))
    If MS1.TextMatrix(i, 2) <> "" Then rs3.Fields("商品编号") = Trim(MS1.TextMatrix(i, 2))
    If MS1.TextMatrix(i, 3) <> "" Then rs3.Fields("规格") = Trim(MS1.TextMatrix(i, 3))
    If MS1.TextMatrix(i, 4) <> "" Then rs3.Fields("产地") = Trim(MS1.TextMatrix(i, 4))
    If MS1.TextMatrix(i, 5) <> "" Then rs3.Fields("单位") = Trim(MS1.TextMatrix(i, 5))
    If MS1.TextMatrix(i, 6) <> "" Then rs3.Fields("进价") = Val(MS1.TextMatrix(i, 6))
    If MS1.TextMatrix(i, 7) <> "" Then rs3.Fields("数量") = Val(MS1.TextMatrix(i, 7))
    If MS1.TextMatrix(i, 8) <> "" Then rs3.Fields("金额") = Val(MS1.TextMatrix(i, 8))
    If gys.Text <> "" Then rs3.Fields("供应商") = Trim(gys.Text)
    rs3.Fields("操作员") = frm_main.St1.Panels(3).Text
    If jsr.Text <> "" Then rs3.Fields("经手人") = Trim(jsr.Text)
    If rq.Text <> "" Then rs3.Fields("日期") = Trim(rq.Text)
    If ph.Text <> "" Then rs3.Fields("票号") = Trim(ph.Text)
    If ck.Text <> "" Then rs3.Fields("仓库") = Trim(ck.Text)
    rs3.Update
    '筛选符合商品编号和仓库的记录
    rs5.Open "select * from kc where 商品编号='" & Trim(MS1.TextMatrix(i, 2)) & "'and 仓库='" & Trim(ck.Text) & "'", cnn, adOpenKeyset, adLockOptimistic
    If rs5.RecordCount > 0 Then     '当记录大于零时
       If rs5.Fields("商品名称") <> "" Then
        '更新库存数量、库存金额
         rs5.Fields("库存数量") = rs5.Fields("库存数量") + Trim(Val(MS1.TextMatrix(i, 7)))
         rs5.Fields("库存金额") = Val(rs5.Fields("库存数量")) * Val(rs5.Fields("进价"))
         rs5.Update
       End If
      Else
      '添加新记录到"kc"表中
       rs5.AddNew
       If MS1.TextMatrix(i, 1) <> "" Then rs5.Fields("商品名称") = MS1.TextMatrix(i, 1)
       If MS1.TextMatrix(i, 2) <> "" Then rs5.Fields("商品编号") = MS1.TextMatrix(i, 2)
       If MS1.TextMatrix(i, 3) <> "" Then rs5.Fields("规格") = MS1.TextMatrix(i, 3)
       If MS1.TextMatrix(i, 4) <> "" Then rs5.Fields("产地") = MS1.TextMatrix(i, 4)
       If MS1.TextMatrix(i, 5) <> "" Then rs5.Fields("单位") = MS1.TextMatrix(i, 5)
       If MS1.TextMatrix(i, 6) <> "" Then rs5.Fields("进价") = Val(MS1.TextMatrix(i, 6))
       If MS1.TextMatrix(i, 7) <> "" Then rs5.Fields("库存数量") = Val(MS1.TextMatrix(i, 7))
       If MS1.TextMatrix(i, 8) <> "" Then rs5.Fields("库存金额") = Val(MS1.TextMatrix(i, 8))
       If ck.Text <> "" Then rs5.Fields("仓库") = ck.Text
       rs5.Update
      End If
      rs5.Close
      '添加记录到gysmx表中
      rs6.Open "select * from gysmx", cnn, adOpenKeyset, adLockOptimistic
      If rs6.EOF = False Then rs6.MoveLast
      rs6.AddNew
      If rq.Text <> "" Then rs6.Fields("日期") = rq.Text
      rs6.Fields("时间") = Time
      If ph.Text <> "" Then rs6.Fields("票号") = ph.Text
      If MS1.TextMatrix(i, 7) <> "" Then rs6.Fields("数量") = MS1.TextMatrix(i, 7)
      If MS1.TextMatrix(i, 8) <> "" Then rs6.Fields("金额小计") = MS1.TextMatrix(i, 8)
      If MS1.TextMatrix(i, 6) <> "" Then rs6.Fields("单价") = MS1.TextMatrix(i, 6)
      If MS1.TextMatrix(i, 5) <> "" Then rs6.Fields("单位") = MS1.TextMatrix(i, 5)
      If gys.Text <> "" Then rs6.Fields("供应商全称") = gys.Text
      If gys.Text <> "" Then rs6.Fields("摘要") = "进货:从【" & gys.Text & "】购进" & "【" & MS1.TextMatrix(i, 1) & "," & MS1.TextMatrix(i, 3) & "】"
      rs6.Update     '更新数据库
      rs6.Close
      Adodc5.Refresh
   End If
  Next i
  '添加新记录到"rkph"表中
  rs4.Open "select * from rkph", cnn, adOpenKeyset, adLockOptimistic
  rs4.AddNew
  If ph.Text <> "" Then rs4.Fields("入库票号") = Trim(ph.Text)
  rs4.Fields("品种数") = pz.Text
  rs4.Fields("数量") = hjsl.Text
  rs4.Fields("金额") = hjje.Text
  rs4.Fields("折扣") = zk.Text
  rs4.Fields("税率") = Val(sl.Text) / 100
  rs4.Fields("应付") = Val(yfje.Text)
  rs4.Fields("实付") = Val(sf.Text)
  rs4.Fields("未付") = Val(wf.Text)
  rs4.Fields("供应商全称") = Trim(gys.Text)
  rs4.Fields("日期") = Trim(rq.Text)
  rs4.Fields("付款方式") = Combo1.Text
  If Val(wf.Text) <= 0 Then rs4.Fields("是否结清") = 1 Else rs4.Fields("是否结清") = 0
  rs4.Update     '更新数据库
  rs4.Close
  Adodc5.RecordSource = "select * from gysmx where 供应商全称 ='" + gys.Text + "'and 累计余额>0 order by 日期,时间"
  Adodc5.Refresh
  If Adodc5.Recordset.EOF = False Then Adodc5.Recordset.MoveLast
  If Adodc5.Recordset.RecordCount > 0 Then
     If Adodc5.Recordset.Fields("累计余额") <> "" Then gysye.Text = Adodc5.Recordset.Fields("累计余额")
  End If
  Adodc5.RecordSource = "select * from gysmx where 供应商全称 ='" + gys.Text + "'order by 日期,时间"
  Adodc5.Refresh
  If Adodc5.Recordset.EOF = False Then Adodc5.Recordset.MoveLast
  If Adodc5.Recordset.RecordCount > 0 Then
     Adodc5.Recordset.Fields("欠款记帐") = Val(wf.Text)
     Adodc5.Recordset.Fields("累计余额") = Val(gysye.Text) + Val(wf.Text)
  End If
  Adodc5.Recordset.Update
 '设置控件状态
  Combc.Enabled = False: Comdj.Enabled = True: Comqx.Enabled = False
  MS1.Enabled = False: sf.Enabled = False
  Text1.Visible = False: grid1.Visible = False: DataList1.Visible = False
 Else
  MsgBox ("填写数据不完整,请核对,再保存")
  MS1.Col = 1: MS1.Row = 1
  grid1.Visible = False
 End If
 rs3.Close     '关闭数据集对象
End Sub
Private Sub Comqx_Click()     '取消操作
 For i = 1 To 101
 For j = 1 To 8
     MS1.TextMatrix(i, j) = ""
 Next j
 Next i
 MS1.Enabled = False: Comdj.Enabled = True: sf.Enabled = False
 Text1.Visible = False: DataList1.Visible = False
 pz.Text = "0": hjje.Text = "0": hjsl.Text = "0"
 sf.Text = "0": wf.Text = "0": gys.Text = ""
 Comdj.SetFocus
End Sub
Private Sub Comend_Click()
 frm_main.Enabled = True
 Unload Me
End Sub