[原创]一段代码:输入数据不在列表中,自动增加列表的例子

hi-wzj

一个朋友希望达到：在组合框中输入新的客户编码即跳到新的客户档案窗体中输入新客户资料，然后跳回来录入窗体继续输入数据的功能，我在本站找了个朱亦文版主的例子(http://www.office-cn.net/forum.php?mod=viewthread&tid=686&replyID=&skin=1)来看。但我发现一些小的不足：

1、输入新码，跳到档案窗体输入该新客户资料后，返回原录入窗体时，必须重新输入编码或须在下拉列表中重新输入才可通过，否则就又得跳出不在列表的提示。因此增加了一个重新输入编码的动作。

2、打开带参数的客户档案窗体时追加相应的客户编码时，代码分布于两个窗体中不便于理解维护。因此用了个追加查询来代替。

因此将此代码贴上来和大家分享。

注：代码中的窗体组合框控件名称为：“客户”其数据来源于表“客户档案”，然后有一个名字叫“客户档案”的表以及同名的录入窗体。

Private Sub 客户_NotInList(NewData As String, Response As Integer)
'NewData 为您输入的不在列表中的值
If MsgBox("在客户档案中不存在 " & NewData & vbCr & "增加吗？", vbYesNo) = vbYes Then
   '往客户档案表中先增加一个以输入的编码为标准的临时客户,如果表中还有必填的项目都须先用默认值追加进去
   DoCmd.SetWarnings False
   DoCmd.RunSQL "INSERT INTO 客户档案 (客户编码,客户名称 )SELECT '" & NewData & "', '" & NewData & "';"
   DoCmd.SetWarnings True
   '打开客户档案窗体,显示刚才追加大那一记录,以便于更改
   DoCmd.OpenForm "客户档案", acNormal, , "客户编码='" & NewData & "'"
   '放弃刚才的输入然后刷新组合框的列表数据,然后程序再填写一遍新值
   Me.客户.Undo
   Me.客户.Requery
   Me.客户 = NewData
Else
   客户.SetFocus
End If

'取消系统默认的不在列表中的提示信息
Response = acDataErrContinue
End Sub

[此贴子已经被作者于2007-2-9 17:10:30编辑过]

tz-chf

好象用不着runsql吧

客户窗体：

Private Sub Form_Load()
    If Not IsNull(Me.OpenArgs) Then
        Me.供应商 = Me.OpenArgs
    End If

End Sub


输入窗体：

Private Sub 供应商ID_NotInList(NewData As String, Response As Integer)
    Dim intReply As Integer
   
    intReply = MsgBox("当前供应商‘" & NewData & _
        "’不存在。" & vbCrLf & vbCrLf & "是否增加？", vbYesNo, "注意")
        
    If intReply = vbYes Then
        DoCmd.OpenForm "供应商窗体", , , , acFormAdd, acDialog, NewData
        Response = acDataErrAdded
    Else
        MsgBox "请重新选择供应商。", vbCritical
        Response = acDataErrContinue
    End If
   
End Sub

hi-wzj

回复：tz-chf  第一楼第2点不是说明了吗？

代码分布于两个窗体中不便于理解和维护。代码在一起一目了然。

tz-chf

很简单嘛，有什么不好理解的。

DoCmd.RunSQL "INSERT INTO 客户档案 (客户编码,客户名称 )SELECT '" & NewData & "', '" & NewData & "';"


“客户编码”和“客户名称”一样吗？？？

还有怎么用select，不用values

[此贴子已经被作者于2007-2-9 20:55:39编辑过]

gdfsslec

谢谢版主分享！
我原来也是用两个窗体，代码只在一个窗体
Private Sub 出货客户_NotInList(NewData As String, Response As Integer)
On Error Resume Next

    If MsgBox("没有这个客户，是否要立即添加？", 4) = 6 Then
       DoCmd.OpenForm "客户录入", , , , acFormAdd
       Forms![客户录入]![客户名称] = Me![出货客户].Text
       Response = acDataErrContinue
      
       DoCmd.RunCommand acCmdSaveRecord
       Forms![出货录入]![出货客户].Undo
       Forms![出货录入]![出货客户].Requery
       Forms![出货录入]![出货客户] = Forms![客户录入]![客户名称]
       DoCmd.Close
    Else
       SendKeys "{escape}"
    End If
   
End Sub
但是弊端是如果要直接加入不做修改，“客户录入”窗体会一闪而过，不爽！用docmd.echo false无效。用您的办法就没有这个问题了，只要不要打开“客户档案”窗体就是了