Office中国论坛/Access中国论坛

标题: 全自定义自动编号，带断号检测补号功能 [打印本页]
作者: andymark    时间: 2008-4-2 22:51
标题: 全自定义自动编号，带断号检测补号功能
适用格式 : XXX-YYYYMMDD-0000

  Public Function ZDYBH(StrTable As String, StrField As String, StrBH As String, Optional FDay As String = "YYMMDD", Optional ILen As Integer = 3, Optional B As Boolean = False) As String
'==================================================================
'功能: 自定义用户编号,带断号重号检测功能
'格式: "XXX"-"日期格式 "-"0000"
'      StrTable 为任意表名称
'      StrField 为任意字段名称
'      StrBH    编码类型 , 可自义任意格式
'      FDay     日期格式 默认日期格式为:YYMMDD",其他符合FORMAT格式的如 YYYYMM,YYYY,YYYYMMDD
'      ILen     为数字格式化长度 , 默认长度为3 代表 000 格式
'      B        为是否要检测断号 ,默认为FALSE 不检测
'用法:  ZDYBH("产量表", "产量ID", "LDH")
'       ZDYBH("产量表", "产量ID", Me.Combo1)
'       ZDYBH("产量表", "产量ID", Me.Combo1, "YYYY")
'       ZDYBH("产量表", "产量ID", Me.Combo1, , 4, True)
'作者: andymark
' QQ : 42503577 , ewang11@163.com
'日期: 2008-4-2
'===============================================================
Dim Rs As New ADODB.Recordset
Dim Conn As New ADODB.Connection
Dim Str As String
Dim Num As Integer
Dim TNum As Integer
Dim StrWhere As String
Dim StrOrderWhere As String
Dim StrOrderWhereDesc As String
Set Conn = CurrentProject.Connection
Str = StrBH & "-" & Format(Now(), "" & FDay & "") & "-"
StrWhere = "select " & StrField & " from " & StrTable & " where " & StrField & " like  '" & Str & "%'"
StrOrderWhere = StrWhere & " Order by  " & StrField & ""
StrOrderWhereDesc = StrWhere & " Order by  " & StrField & " DESC"
Rs.Open StrOrderWhereDesc, Conn, adOpenKeyset, adLockOptimistic
  If Rs.EOF Then
   
      Num = 0
  
    Else
   
      Num = Right(Rs.Fields("" & StrField & ""), ILen)
   
      If B = True Then
      
         If CInt(Num) <> Rs.Fields.Count Then
         
            Rs.Close
            Rs.Open StrOrderWhere, Conn, adOpenKeyset, adLockOptimistic
         
            Num = 0
         
            Do While Not Rs.EOF
           
               TNum = CInt(Right(Rs.Fields("" & StrField & ""), ILen))
               
               If TNum = Num Then
                  
                   MsgBox StrBH & "-" & Format(Now(), "" & FDay & "") & "-" & Format(Num, String(ILen, "0")) & "存在重号,请检查数据的"
                   Exit Function
                 Else
                 
                   If TNum - Num = 1 Then
                 
                      Num = TNum
                     Else
               
                      Exit Do
               
                   End If
               
                End If
              
              Rs.MoveNext
           
            Loop
        
        
         End If
     
      End If
   
  End If
ZDYBH = StrBH & "-" & Format(Now(), "" & FDay & "") & "-" & Format(Num + 1, String(ILen, "0"))
Set Rs = Nothing
Set Conn = Nothing
End Function
作者: gdfsslec    时间: 2008-4-2 23:15
谢谢版主！慢慢研究
作者: goto2008    时间: 2008-4-2 23:38
大哥，能给个库吗？。。
作者: andymark    时间: 2008-4-3 00:03
已上传简单的例子
作者: tmtony    时间: 2008-4-3 00:38
这是个很实用的例子!!
作者: glw    时间: 2008-4-3 06:25
[:50]
作者: huangqinyong    时间: 2008-4-3 06:30
thanks,收藏了
作者: glw    时间: 2008-4-3 08:13
[:50]
作者: andymark    时间: 2008-4-3 11:31
重新修正, 支持重号检测
例子已更新
作者: laiguiyou    时间: 2008-4-3 14:07
非常好的实例，收藏了。
作者: calvinho    时间: 2008-4-3 15:24
谢谢楼主，我回去慢慢研究
作者: v_tang    时间: 2008-4-3 16:46
学习　　　　　　　　　　　　　　
作者: outlookpc    时间: 2008-5-21 00:03
好,谢谢
作者: xiaobing.wang    时间: 2008-5-22 11:17
好东西，谢谢
作者: 7777777    时间: 2008-5-29 10:20
重新修正
作者: su_xx    时间: 2008-5-29 10:40
谢谢版主,先下了看看,全力支持!
作者: zczc123    时间: 2008-6-26 15:07
下不了哦
作者: yori2007    时间: 2008-7-8 09:05
[:50]
作者: wellcome_gx    时间: 2008-10-5 20:48
很好很强大[:28]
作者: 明镜    时间: 2008-10-6 07:46
这个好
作者: zss427607    时间: 2008-10-6 12:35
好东西  先下了  学习一下[:50] [:50]
作者: open0    时间: 2008-10-13 10:48
good
作者: hhhx2008    时间: 2009-1-18 01:46
某些时候有用
作者: Henry D. Sy    时间: 2009-1-18 07:03
谢谢分享
作者: hayhay    时间: 2009-1-19 08:02
很实用的例子
作者: 雨后的天空    时间: 2009-2-24 13:57
我要看看
作者: 346700841    时间: 2009-2-24 20:54
多谢了，又学习了一项。
作者: 紫风    时间: 2009-2-24 21:52
谢谢楼主！
作者: 阿六爱狗    时间: 2009-4-8 13:03
谢谢分享
作者: narcissus82    时间: 2009-4-10 15:31
thank u
作者: jameszheng1981    时间: 2009-7-1 09:57
andy,您太NB了
作者: Sundy1250    时间: 2009-7-2 10:27
可以用作物料BOM类的不
作者: benhh    时间: 2009-7-26 09:31
代码已经copy，连同您的版权信息，谢谢！
作者: yzt880    时间: 2013-1-22 14:40
高人做的 很地道的代码 我改进到我的软件中，使用很顺手。
作者: yzt880    时间: 2013-1-22 14:41
Public Function ZDYBH1(StrTable As String, StrField As String, StrBH As String, Optional FDay As String = "YYYYMMDD", Optional ILen As Integer = 3, Optional bh As String) As String

'==================================================================

'功能: 自定义用户编号,带断号检测功能
'格式: "XXX"-"日期格式 "-"0000"
'      StrTable 为任意表名称
'      StrField 为任意字段名称
'      StrBH    编码类型 , 可自义任意格式
'      FDay     日期格式 默认日期格式为:YYMMDD",其他符合FORMAT格式的如 YYYYMM,YYYY,YYYYMMDD
'      ILen     为数字格式化长度 , 默认长度为3 代表 000 格式
'      B        为是否要检测断号 ,默认为FALSE 不检测
'用法:  ZDYBH("产量表", "产量ID", "LDH")
'       ZDYBH("产量表", "产量ID", Me.Combo1)
'       ZDYBH("产量表", "产量ID", Me.Combo1, "YYYY")
'       ZDYBH("产量表", "产量ID", Me.Combo1, , 4, True)

'作者: andymark
' QQ : 42503577 , ewang11@163.com
'日期: 2008-4-2

'===============================================================


Dim Str As String
Dim Num As Integer
Dim TNum As Integer
Dim StrWhere As String
Dim StrOrderWhere As String
Dim StrOrderWhereDesc As String


Str = Format(Now(), "" & FDay & "")
OpenRS1 "select " & StrField & " from " & StrTable & " where " & StrField & " like  '" & Str & "%' Order by  " & StrField & " DESC", Rs
OpenRS1 "select " & StrField & " from " & StrTable & " where " & StrField & " like  '" & Str & "%' Order by  " & StrField & "", Rs1

If Rs.EOF Then
   
      Num = 0
  
    Else
   
   
   
    Num = Mid(Rs.Fields("" & StrField & ""), 10, ILen)
   
  End If

     
ZDYBH1 = Format(Now(), "" & FDay & "") & "" & bh & "" & Format(Num + 1, String(ILen, "0")) & StrBH
Openrs "INSERT INTO " & StrTable & "(" & StrField & "" & _
      ") values ( '" & ZDYBH1 & "')", Rs2
Set Rs1 = Nothing


End Function
作者: yanhantan    时间: 2013-5-17 22:04
好东西啊，学习学习
作者: 李力军2    时间: 2013-5-19 14:06
谢谢！{:soso_e100:}
作者: yanhantan    时间: 2013-5-23 02:46
真是好东西，就是改不进自己的系统，不会用啊
作者: nbulsj    时间: 2014-6-30 10:25
好东西
作者: knowliu    时间: 2015-2-28 11:50
没密码啊，怎么打开
作者: WFH6898    时间: 2015-11-12 12:35
[模块/函数] 全自定义自动编号，带断号检测补号功能，软件编号的神器，多学习了
作者: p51218    时间: 2016-11-14 22:38
www.office-cn.net
作者: wzfa1206    时间: 2017-9-8 11:46
不能自定义 日期的时间啊..
这个只能是当前日期的自动编号
求增加自选 日期参数..
作者: lonebca    时间: 2020-9-8 17:29

这是个很实用的例子!!
作者: jun_hai    时间: 2023-3-15 12:06
谢谢！！！！！



欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3