请教这段程序哪里出错了!

Haoxu123

为什么在一个数据库文件中可以,在另一个数据库文件中就不能执行了呢,在线等待中...
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

盗到稻

If IsNull(Me![客户名称])  Then
        '弹出提示“订单号“文本框不可以为空信息
        MsgBox "请输入'客户名称',它不可以为空!", vbOKOnly, "输入'客户名称'"
        Me![客户名称].SetFocus
exit sub
end if
……   
    If IsNull(Me![总价])  Then
        MsgBox "请输入'总价',它不可以为空!", vbOKOnly, "输入'总价'"
        Me![总价].SetFocus
        exit sub
end if

[ 本帖最后由 盗到稻 于 2007-10-18 14:30 编辑 ]

zyz218

我想你那个是保存按钮代码吧？请参考以下代码：

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

如果是修改按钮代码，请参考以下代码：

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

两位的都试过了,都不行

Grant

是不是ADO版本引用问题,请看看

Haoxu123

ADO版本也没有问题,再请教各位

hi-wzj

是修改按钮的代码，但我改了单价值，然后点修改，能够正常修改。
请具体描述出错情况。
建议将  '判断"订单号"等文本框是否为空前的ado赋值打开代码放到else代码的后面。

也就是判断输入都正常后才打开数据表。

Haoxu123

是指当输入完一条记录＂保存＂后，对其进行＂修改＂操作，按修改键后数据不变

yangwenhong

帮忙看看，不知道能不能帮上忙

[ 本帖最后由 yangwenhong 于 2007-10-19 22:19 编辑 ]