标题: 请教这段程序哪里出错了! [打印本页] 作者: Haoxu123 时间: 2007-10-18 11:22 标题: 请教这段程序哪里出错了! 为什么在一个数据库文件中可以,在另一个数据库文件中就不能执行了呢,在线等待中...
Private Sub Command24_Click()
On Error GoTo Err_Command24_Click
'定义用于循环的整型变量
Dim i As Integer
'定义字符型变量
Dim STemp As String
'定义数据集变量分配空间
Dim Rs As ADODB.Recordset
'为定义的数据集变量分配空间
Set Rs = New ADODB.Recordset
'为打开数据表“查询语句”字符变量赋值
STemp = "Select * From 销售表"
'打开“销售表”数据表
Rs.Open STemp, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'判断"订单号"等文本框是否为空
If IsNull(Me![客户名称]) = True Then
'弹出提示“订单号“文本框不可以为空信息
MsgBox "请输入'客户名称',它不可以为空!", vbOKOnly, "输入'客户名称'"
Me![客户名称].SetFocus
ElseIf IsNull(Me![销售品种]) = True Then
MsgBox "请输入'销售品种',它不可以为空!", vbOKOnly, "输入'销售品种'"
Me![销售品种].SetFocus
ElseIf IsNull(Me![单位]) = True Then
MsgBox "请输入'单位',它不可以为空!", vbOKOnly, "输入'单位'"
Me![单位].SetFocus
ElseIf IsNull(Me![数量]) = True Then
MsgBox "请输入'数量',它不可以为空!", vbOKOnly, "输入'数量'"
Me![数量].SetFocus
ElseIf IsNull(Me![单价]) = True Then
MsgBox "请输入'单价',它不可以为空!", vbOKOnly, "输入'单价'"
Me![单价].SetFocus
ElseIf IsNull(Me![总价]) = True Then
MsgBox "请输入'总价',它不可以为空!", vbOKOnly, "输入'总价'"
Me![总价].SetFocus
Else
Rs.MoveFirst '把数据集指针指向第一记录
'使用For....Next循环在数据集中搜索相同“订单号”的记录
For i = 1 To Rs.RecordCount
If Rs("客户名称") = Me![销售表子窗体]![客户名称] Then
'修改“销售表”数据表字段值
Rs("销售品种") = Me![销售品种]
Rs("单位") = Me![单位]
Rs("数量") = Me![数量]
Rs("单价") = Me![单价]
Rs("总价") = Me![总价]
'Rs("总数") = Me![总数]
' Rs("总额") = Me![总额]
'使用记录集的Update方法来刷新记录集
Rs.Update
'刷新'销售表子窗体'子窗体
Me![销售表子窗体].Requery
'弹出“修改完成”的提示信息
MsgBox "销售表己经修改完成!", vbOKOnly, "修改完成"
Exit Sub '退出子过程
Else
Rs.MoveNext '把记录指针移到下一条记录
End If
Next i
End If
'释放系统为Rs数据集分配的空间
Set Rs = Nothing
Exit_Command24_Click:
Exit Sub
Err_Command24_Click:
MsgBox Err.Description
Resume Exit_Command24_Click
End Sub作者: 盗到稻 时间: 2007-10-18 14:27
If IsNull(Me![客户名称]) Then
'弹出提示“订单号“文本框不可以为空信息
MsgBox "请输入'客户名称',它不可以为空!", vbOKOnly, "输入'客户名称'"
Me![客户名称].SetFocus
exit sub
end if
……
If IsNull(Me![总价]) Then
MsgBox "请输入'总价',它不可以为空!", vbOKOnly, "输入'总价'"
Me![总价].SetFocus
exit sub
end if
Private Sub saverec_Click()
On Error GoTo Err_saverec_Click
Dim i As Integer
Dim STemp As String
Dim Rs As ADODB.Recordset
Set Rs = New ADODB.Recordset
STemp = "Select * From matin"
Rs.Open STemp, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
If IsNull(Me.indate) = True Then
MsgBox "请输入“入库日期”，它不可以为空!", vbOKOnly, "输入“入库日期”"
Me.indate.SetFocus
Exit Sub
ElseIf IsNull(Me.partcode) = True Then
MsgBox "请输入“耗材编号”，它不可以为空!", vbOKOnly, "输入“耗材编号”"
Me.partcode.SetFocus
Exit Sub
ElseIf IsNull(Me.inqty) = True Then
MsgBox "请输入“入库数量”，它不可以为空!", vbOKOnly, "输入“入库数量”"
Me.inqty.SetFocus
Exit Sub
ElseIf IsNull(Me.linename) = True Then
MsgBox "请输入“所属线别”，它不可以为空!", vbOKOnly, "输入“所属线别”"
Me.linename.SetFocus
Exit Sub
Else
If Rs.RecordCount > 0 Then
Rs.MoveFirst
For i = 1 To Rs.RecordCount
If Rs("indate") = Me.indate And _
Rs("partcode") = Me.partcode Then
MsgBox "该记录已存在，请核实!", vbCritical, "记录已经存在"
Exit Sub
Else
Rs.MoveNext
End If
Next i
End If
End If
DoCmd.SetWarnings False
STemp = "INSERT INTO matin"
STemp = STemp & "(indate,partcode,inqty,linename)"
STemp = STemp & "VALUES ('" & Me.indate & "','" & Me.partcode & "',"
STemp = STemp & "'" & Me.inqty & "','" & Me.linename & "')"
DoCmd.RunSQL STemp
STemp = "update maton set onqty=onqty+" & Me.inqty & " where partcode='" & Me.partcode & "' and linename='" & Me.linename & "'"
DoCmd.RunSQL STemp
Me.matin_sub.Requery
Set Rs = Nothing
Exit_saverec_Click:
Set Rs = Nothing
Exit Sub
Err_saverec_Click:
MsgBox Err.Description
Resume Exit_saverec_Click
End Sub作者: zyz218 时间: 2007-10-18 15:07
如果是修改按钮代码，请参考以下代码：
Private Sub modrec_Click()
On Error GoTo Err_modrec_Click
Dim i As Integer
Dim STemp As String
Dim Rs As ADODB.Recordset
Set Rs = New ADODB.Recordset
STemp = "Select * From matin"
Rs.Open STemp, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
If IsNull(Me.indate) = True Then
MsgBox "请输入“入库日期”，它不可以为空!", vbOKOnly, "输入“入库日期”"
Me.indate.SetFocus
Exit Sub
ElseIf IsNull(Me.partcode) = True Then
MsgBox "请输入“耗材编号”，它不可以为空!", vbOKOnly, "输入“耗材编号”"
Me.partcode.SetFocus
Exit Sub
ElseIf IsNull(Me.inqty) = True Then
MsgBox "请输入“入库数量”，它不可以为空!", vbOKOnly, "输入“入库数量”"
Me.inqty.SetFocus
Exit Sub
ElseIf IsNull(Me.linename) = True Then
MsgBox "请输入“所属线别”，它不可以为空!", vbOKOnly, "输入“所属线别”"
Me.linename.SetFocus
Exit Sub
Else
If Rs.RecordCount < 1 Then
Exit Sub
End If
Rs.MoveFirst
For i = 1 To Rs.RecordCount
If Rs("indate") = Me![matin_sub]![indate] And _
Rs("partcode") = Me![matin_sub]![partcode] Then
Rs("indate") = Me.indate
Rs("partcode") = Me.partcode
Rs("inqty") = Me.inqty
Rs("linename") = Me.linename
Rs.Update
Me.matin_sub.Requery
MsgBox "耗材记录已修改完成！", vbOKOnly, "修改完成"
DoCmd.SetWarnings False
STemp = "update maton set onqty=onqty-" & m & "+" & n & " where partcode='" & Me.partcode & "' and linename='" & Me.linename & "'"
DoCmd.RunSQL STemp
Exit Sub
Else
Rs.MoveNext
End If
Next i
End If
Set Rs = Nothing
Exit_modrec_Click:
Set Rs = Nothing
Exit Sub
Err_modrec_Click:
MsgBox Err.Description
Resume Exit_modrec_Click
End Sub作者: Haoxu123 时间: 2007-10-18 17:26
两位的都试过了,都不行作者: Grant 时间: 2007-10-18 18:18
是不是ADO版本引用问题,请看看作者: Haoxu123 时间: 2007-10-19 08:50
ADO版本也没有问题,再请教各位作者: hi-wzj 时间: 2007-10-19 10:45
是修改按钮的代码，但我改了单价值，然后点修改，能够正常修改。
请具体描述出错情况。
建议将 '判断"订单号"等文本框是否为空前的ado赋值打开代码放到else代码的后面。
