删除ListView1中的记录
窗体中，加载Access中的数据到ListView1列表中后，可以选择ListView1中的多项内容，点击删除后，对应的Access数据库的数据，也一并删除。
同时，Access数据中的序号，重新按顺序编号。
求解，谢谢！ 附件：
DC3.zip
(358.77 KB)
'============================================================================================================================
'-函数名称： AutoNum
'-功能描述： 具有断号重续功能的自动编号函数，支持文本型和长整型数值的自动编号
'-输入参数： 参数1：TableName 必需的，表名
' 参数2：FieldName 必需的，自动编号字段名
' 参数3：Prefixal 可选的，编号前缀，编号字段数据类型为文本时才起作用
' 参数4：Digit 可选的（文本型编号时为必需），文本型编号位数(不包含前缀的)
' 参数5：SerialNumber 可选的，设为true时使用断号重续，设为false时不理会断号，只在已有最大编号上加1
'-其它说明： 使用文本型自动编号时，如果记录数目可能会比较大时，建议使用含有日期的前缀或将编号位数设大一些，否则如果达到编号
' 上限将不能添加记录
'
'-使用注意： 调用的自动编号字段必须设置唯一索引，并且不能允许为空，最好是作为主键使用
'-返回参数： 正常情况下返回从1开始的最小断号，如无断号返回最大号加1；出错时返回Null
'-兼 容 性： 字段的数据类型必须为文本型或者长整型数值，如设成其它均会只返回Null
'-使用示例： Me.OrderID.DefaultValue="""" & AutoNum("Orders","OrderID","OD" & Format(Date(),"yyyymm"),5) & """"
' 返回值：OD19910100001，OD19910100002，OD19910400001，……
'-相关调用：
'-作 者： 红尘如烟
'-创建日期： 20010-4-25
'=============================================================================================================================
Function AutoNum(TableName As String, FieldName As String, _
Optional Prefixal As String, Optional Digit As Integer, _
Optional SerialNumber As Boolean = False) As Variant
On Error GoTo Err_AutoNum
Dim strSQL As String
Dim intDataType As Integer
Dim rst As DAO.Recordset
Dim strErrMsg As String
Dim intI As Integer
Dim strExpr As String
If TableName = "" Or FieldName = "" Then Err.Raise 3265
If TableName Like "[[]*]" Then TableName = Mid$(TableName, 2, Len(TableName) - 2)
If FieldName Like "[[]*]" Then FieldName = Mid$(FieldName, 2, Len(FieldName) - 2)
strExpr = Prefixal
strExpr = Replace(strExpr, "'", "''")
intDataType = CurrentDb.TableDefs(TableName).Fields(FieldName).Type
If intDataType = 10 Then
If Digit < 1 Then Err.Raise 1, , "文本型自动编号的编号位数不能小于1位。"
If SerialNumber Then
strSQL = "SELECT (Right([" & FieldName & "]," & Digit & ")+0) AS Expr1000 FROM [" & TableName & "] " & _
"WHERE Left([" & FieldName & "]," & Len(Prefixal) & ")= '" & strExpr & "' " & _
"ORDER BY (Right([" & FieldName & "]," & Digit & ")+0);"
Else
strSQL = "SELECT Max(Right([" & FieldName & "]," & Digit & ")+0) AS Expr1000 FROM [" & TableName & "] " & _
"WHERE Left([" & FieldName & "]," & Len(Prefixal) & ")= '" & strExpr & "';"
End If
ElseIf intDataType = 4 Then
If SerialNumber Then
strSQL = " SELECT [" & FieldName & "] AS Expr1000 FROM [" & TableName & "] ORDER BY [" & FieldName & "];"
Else
strSQL = " SELECT Max([" & FieldName & "]) AS Expr1000 FROM [" & TableName & "];"
End If
Else
Err.Raise 2, , "不支持此数据类型的自动编号。"
End If
' Debug.Print strSQL
Set rst = CurrentDb.OpenRecordset(strSQL)
If rst.RecordCount = 0 Then
AutoNum = 1
Else
If SerialNumber Then
rst.MoveLast
If rst!Expr1000 = rst.RecordCount Then
AutoNum = rst.RecordCount + 1
Else
rst.MoveFirst
For intI = 1 To rst.RecordCount
If rst!Expr1000 <> intI Then
AutoNum = intI
Exit For
Else
rst.MoveNext
End If
Next
End If
Else
AutoNum = Nz(rst!Expr1000, 0) + 1
End If
End If
If intDataType = 10 Then
If Len(AutoNum) > Digit Then
Err.Raise 3, , "自动编号已达最大上限，不能再添加记录。"
Else
AutoNum = Prefixal & Format$(AutoNum, String$(Digit, "0"))
End If
End If
Exit_AutoNum:
Set rst = Nothing
Exit Function
Err_AutoNum:
AutoNum = Null
Select Case Err
Case 3265
strErrMsg = "指定的表名或字段名不存在。"
Case Else
strErrMsg = Err.Description
End Select
MsgBox "#" & Err & vbCrLf & strErrMsg, vbCritical, "自动编号函数出错"
Resume Exit_AutoNum
End Function
转至《Office中国论坛》
-------------------
我想到的是对整个数据库的数据重新更新，编排序号。
你的不重复关键字，没有确定，只能以序号来确定，所以这个编排序号，需要倒序进行。
指针移最后
N=取记录条数
do while 数据库不是在头 or N>0
更新序号为 N
n=N-1
指针向前移
loop
一句话，时间都要花费很长的时间，随着数据库的增长，这个时间会越来越长。
-------
我的电脑上不装 MS OFFICE 了，所以你的程序我无法调试。
另外，所有的变量都强烈建议申明，一是选项里开这个选项，二是代码窗口第一行凡没有 Option Explicit 这句的，手动补上。可以免去很多麻烦。
-------------
问一句，为啥要排数据库里的序号？
[此贴子已经被作者于2017-8-9 11:03编辑过]
DC3.rar