Dim s, Y, i     '定义变量
Dim rs1 As ADODB.Recordset
Dim rs2 As ADODB.Recordset
Dim rs3 As ADODB.Recordset
Dim lsph As Integer     '定义一个整型变量
Dim cnn As ADODB.ConnectionPrivate Sub Command1_Click()
Load Forkcx
Forkcx.Show
Unload MeEnd SubPrivate Sub Form_Load()
 '定义mf1表的总行数、总列数
 mf1.Rows = 102
 mf1.Cols = 12
'定义mf1表的列宽和表头信息
 s = Array("300", "1500", "900", "1200", "900", "1200", "600", "600", "600", "900", "1140", "850")
 Y = Array("No.", "商品名称", "简称", "编号", "厂家", "规格", "包装", "单位", "数量", "单价", "金额", "备注")
 For i = 0 To 11
  mf1.ColWidth(i) = s(i)
  mf1.TextMatrix(0, i) = Y(i)
 Next i
 '定义mf1表的固定行数、固定列数
 mf1.FixedRows = 1
 mf1.FixedCols = 1
 '定义mf1表的列序号
 For i = 1 To 101
     mf1.TextMatrix(i, 0) = i
 Next i
 rkrq.Text = Date     '设置入库日期
 Set cnn = New ADODB.Connection
 cnn.Open "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=admin.mdb"
End Sub
Private Sub gys_KeyDown(KeyCode As Integer, Shift As Integer)
 If KeyCode = vbKeyReturn Then jsr.SetFocus     '按回车键jsr获得焦点
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()
 '确定text1在mf1表格中的大小及位置
 Dim X, Y As String
 If mf1.CellWidth <= 0 Or mf1.CellHeight <= 0 Then Exit Sub
 X = mf1.TextMatrix(mf1.FixedRows, mf1.Col)
 Y = mf1.TextMatrix(mf1.Row, 0)
  If Y <> "" Then
   If mf1.Col - mf1.LeftCol <= 3 Then
      mf1.LeftCol = mf1.LeftCol + 1
   End If
   If mf1.CellWidth > 0 And mf1.CellHeight > 0 Then
      text1.Width = mf1.CellWidth
      text1.Height = mf1.CellHeight
      text1.Left = mf1.CellLeft + mf1.Left
      text1.Top = mf1.CellTop + mf1.Top
   End If
   X = mf1.TextMatrix(mf1.FixedRows, mf1.Col)
   Y = mf1.TextMatrix(mf1.Row, 0)
   p = mf1.TextMatrix(mf1.Row, mf1.Col)
   text1.Text = mf1.Text
   text1.SelStart = 0
   text1.SelLength = Len(text1.Text)
  End If
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 SubPrivate Sub smain_Click()
Load main
main.Show
Unload MeEnd SubPrivate Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
 '按键盘左键,text1向左移动
 If KeyCode = vbKeyReturn Then
    If mf1.Col = 10 Then
       mf1.Row = mf1.Row + 1
       mf1.Col = 1
     Else
       If mf1.Col + 1 <= mf1.Cols - 1 Then
          mf1.Col = mf1.Col + 1
        Else
          If mf1.Row + 1 <= mf1.Rows - 1 Then
             mf1.Row = mf1.Row + 1
             mf1.Col = 1
          End If
       End If
    End If
  End If
  '按键盘向上键,text1向上移动
  If KeyCode = vbKeyUp Then
     If mf1.Row > 1 Then mf1.Row = mf1.Row - 1
  End If
  '按键盘向下键,text1向下移动
  If KeyCode = vbKeyDown And (mf1.TextMatrix(mf1.Row, 2)) <> "" Then
     If mf1.Row < 99 Then mf1.Row = mf1.Row + 1
  End If
  '按键盘左键,text1向左移动
  If KeyCode = vbKeyLeft Then
   If text1.Text <> "" Then
     text1.SelStart = 0
     text1.SelLength = Len(text1.Text)
   End If
   If mf1.Col - 11 <= mf1.Cols + 1 Then
      mf1.Col = mf1.Col - 1
      If mf1.Col = 0 Then mf1.Col = 1
     Else
      If mf1.Row + 1 <= mf1.Row - 1 Then
         mf1.Row = mf1.Row + 1
         mf1.Col = 1
      End If
   End If
 End If
 '按键盘左键,text1向右移动
 If KeyCode = vbKeyRight Then
  If text1.Text <> "" Then
     text1.SelStart = 0
     text1.SelLength = Len(text1.Text)
  End If
  If mf1.Col + 1 <= mf1.Cols - 1 Then
     mf1.Col = mf1.Col + 1
    Else
     If mf1.Row + 1 <= mf1.Rows - 1 Then
        mf1.Row = mf1.Row + 1
        mf1.Col = 1
     End If
  End If
 End If
End Sub
Private Sub Text1_Change()
 mf1.Text = text1.Text     '赋值给mf1.text
 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
  End If
 End If
 If mf1.Col = 11 Then
  If mf1.TextMatrix(mf1.Row, 9) = "" Then
     MsgBox ("单价无,请重新输入!!!")
     mf1.Col = 9
  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 Cmddj_Click()
 '查询所有入库数据,并按票号排序
 Adodc1.RecordSource = "select * from  rkd  order by 票号"
 Adodc1.Refresh
 '创建入库票号
 If Adodc1.Recordset.RecordCount > 0 Then
  If Not Adodc1.Recordset.EOF Then Adodc1.Recordset.MoveLast
     If Adodc1.Recordset.Fields("票号") <> "" Then
        lsph = Right(Trim(Adodc1.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
 text1.Enabled = True
 mf1.Enabled = True
 Cmdbc.Enabled = True
 Cmdqx.Enabled = True
 Cmddj.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

解决方案 »

  1.   

    Private Sub Cmdbc_Click()
     Set rs1 = New ADODB.Recordset
     Set rs2 = New ADODB.Recordset
     'Set rs4 = New ADODB.Recordset
     
     rs1.Open "select * from rkd", cnn, adOpenKeyset, adLockOptimistic
     rs2.Open "select * from rkph", cnn, adOpenKeyset, adLockOptimistic
     'rs4.Open "select *from kc ", cnn, adOpenKeyset, adLockOptimistic
      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        '更新表
      End If
      Set rs3 = New ADODB.Recordset
      rs3.Open "select * from kc where 商品名称='" + Trim(mf1.TextMatrix(i, 1)) + "'", cnn, adOpenKeyset, adLockOptimistic
      If rs3.RecordCount > 0 Then
       rs3.Fields("库存") = Val(rs3.Fields("库存")) + Val(mf1.TextMatrix(i, 8))
      rs3.Fields("库存金额") = Val(rs3.Fields("库存")) * Val(mf1.TextMatrix(i, 9))
      rs3.Update
      End If
     Next i
     rs2.AddNew
     If gys.Text <> "" Then rs2.Fields("供应商") = gys.Text
     If rkrq.Text <> "" Then rs2.Fields("日期") = rkrq.Text
     If PH.Text <> "" Then rs2.Fields("入库票号") = PH.Text
     If js.Text <> "" Then rs2.Fields("品种数") = js.Text
     If hjsl.Text <> "" Then rs2.Fields("数量") = hjsl.Text
     If hj.Text <> "" Then rs2.Fields("金额") = hj.Text
     rs2.Update
     rs1.Close
     rs2.Close
     rs3.Close
     'rs4.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    '设置控件不可见
     '设置控件有效或无效
     mf1.Enabled = False
     Cmdbc.Enabled = False
     Cmddj.Enabled = True
     Cmdqx.Enabled = False
    End Sub
    Private Sub Cmdqx_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
     text1.Enabled = False
     mf1.Enabled = False
     Cmdbc.Enabled = False
     Cmdqx.Enabled = False
     Cmddj.Enabled = True
     Cmddj.SetFocus
    End Submf1的内容只是一个一个单元格的添加,请问的就是如何能把整条记录一下子添加到各个单元格里。我问的问题是不是问的不明白?有需要我进一步解释的吗?