关于300问题的详细内容

pentiuminside 2005-03-21 02:13:55
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.Connection

Private Sub Command1_Click()
Load Forkcx
Forkcx.Show
Unload Me

End Sub

Private 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 Sub

Private Sub smain_Click()
Load main
main.Show
Unload Me

End Sub

Private 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
...全文
21 点赞 收藏 1
写回复
1 条回复
pentiuminside 2005年03月21日
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 Sub

mf1的内容只是一个一个单元格的添加,请问的就是如何能把整条记录一下子添加到各个单元格里。我问的问题是不是问的不明白?有需要我进一步解释的吗?
回复 点赞
发动态
发帖子

863

社区成员

5.5w+

社区内容

VB 数据库(包含打印,安装,报表)
社区公告
暂无公告