[原创源码分享]只有几行代码的自定义自动编号函数

红尘如烟

头几天做东西的时候想到的一个思路，现在空下来完善一下发上来和大家分享

1. '========================================================================================
   
2. '-函 数 名： AutoNumber
   
3. '-函数用途： 设置自定义自动编号
   
4. '-参数说明： 参数1：Prefixal----编号前缀
   
5. '- 参数2：Digit----编号位数
   
6. '- 参数3：FieldName----自动编号所在字段名
   
7. '- 参数4：TableName----自动编号所在表名
   
8. '-返回参数： 调用成功返回将要向新记录中添加的最大编号，调用失败返回空字符串""
   
9. '-调用方法： 在窗体的Current(当前)事件中调用
   
10. '-调用示例： Me.自动编号.DefautValue = AutoNumber("[审]",7,"自动编号","审核表")
    
11. '-使用注意： 表中的自动编号字段数据类型要设成文本型
    
12. '-作 者： 红尘如烟
    
13. '-
    
14. '=============================================================================================
    
15. Function AutoNumber(Prefixal As String, Digit As Integer, FieldName As String, TableName As String) As String
    
16. On Error GoTo AutoNumber_Err
    
17. 
    
18. Dim strMaxID As Long
    
19. Dim strNumberFormat As String
    
20. Dim i As Integer
    
21. 
    
22. strMaxID = Nz(DMax("Right( " & FieldName & "," & Digit & ")", TableName)) + 1
    
23. For i = 1 To Digit
    
24. strNumberFormat = strNumberFormat & "0"
    
25. Next
    
26. AutoNumber = """" & Prefixal & Format(strMaxID, strNumberFormat) & """"
    
27. 
    
28. AutoNumber_Exit:
    
29. Exit Function
    
30. 
    
31. AutoNumber_Err:
    
32. AutoNumber = ""
    
33. MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "自动编号出错"
    
34. Resume AutoNumber_Exit
    
35. End Function

复制代码

游客，如果您要查看本帖隐藏内容请回复

andymark

很实用的功能 [:12]

laiguiyou

支持 [:24]

tmtony

不能不支持一下!

红尘如烟

奇怪，我在１楼的代码是直接复制过来的，最后错误处理那儿应该是AutoNumber=""的，怎么只显示Aut，改都改不了

chenwm1973

学习
[:50] [:50] [:50]

liaug

[:34] [:34] [:34]

wang1950317

学习！谢谢！[:50]

tmtony

复制到写字板,再复制过来是否可以?

红尘如烟

站长老大,还是不行啊,我手动改过后不行,复制到记事本和写字板后再复制过来全都不行,是被屏蔽掉了,还是怎么回事,太奇怪了