组合框自动添加新条目例子

咱家是猫

很久以前做的例子,一直以为曾上传过,今天为了给网友找例子而搜过,竟无果,于是重新上传.

tmtony

收藏并下载。谢谢分享。

asklove

收藏!

liaohk

收藏并下载。谢谢分享。

chuang0321

收下，谢谢分享！

lovehere

收藏学习了。

82077802

收藏并下载。谢谢分享。

yekai_hua

找死我了

wang1950317

学习学习！

todaynew

可进一步写成通用性的函数。以适应类型为数据列表/表和查询，以及为数据源为sql语句等情况。
Public Function newVal(ctl As Control, NewData As String, Response As Integer)
'功能：组合框添加数据
'适用：1、值列表
'      2、表或查询---仅适用一种情况：表中的ID字段为自动编号数据类型。
'示例：在出仓类别的【不在列表中】事件中写入代码：
'   Private Sub 出仓类别_NotInList(NewData As String, Response As Integer)
'      newVal Me.出仓类别, NewData, Response
'   End Sub
Select Case ctl.RowSourceType
    Case "Table/Query"
        Dim rs As New ADODB.Recordset
        Dim ssql As String
        Dim A, i As Long
        If MsgBox("所输数据不在选择列表中,确认存储数据吗？", vbOKCancel, "确认存储数据") = vbOK Then
            Response = acDataErrAdded
            ssql = ctl.RowSource
            rs.Open ssql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
            rs.AddNew
            A = Split(ctl.ColumnWidths, ";")
            For i = 0 To UBound(A, 1)
                If Val(A(i)) > 0 Then
                    Exit For
                End If
            Next
            rs.Fields(i).Value = NewData
            rs.Update
            rs.Close
            ctl.RowSource = ssql
        Else
            Response = acDataErrContinue
            ctl.Undo
        End If
    Case "Value List"
        If MsgBox("所输数据不在选择列表中,确认存储数据吗？", vbOKCancel, "确认存储数据") = vbOK Then
            Response = acDataErrAdded
            ctl.RowSource = ctl.RowSource & ";" & NewData
        Else
            Response = acDataErrContinue
            ctl.Undo
        End If
End Select
End Function