设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

12下一页
返回列表 发新帖
查看: 2671|回复: 10
打印 上一主题 下一主题

[模块/函数] 实现自动编码功能!

[复制链接]
跳转到指定楼层
1#
发表于 2007-8-14 16:05:30 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
   在软件开发中,经常会碰到录入基础资料编码的功能,比如供应商编码或助记码、客户及物料的编码或助记码.而用户大多希望在录入一个编码保存后,系统能自动在新增记录上显示规则的编码,比如输入:A0001能在新记录上显示A0002;KS09新增后自动显示下一记录编码KS10.
以下我从软件中提取自动编码函数,可实现大多数自动编码的功能:
Public Function AUTOINCREE_CODE(CONTENT As Variant) As String
On Error GoTo err
   Dim i, b, itext
   Dim STRCONT As String, ADDTIONZERO As String
   Dim num As Long
   num = 1
   itext = CONTENT
   Do
      i = Mid(itext, Len(itext) - num + 1, 1)
      If Len(i) = 0 Or IsNull(i) Then Exit Do
      b = Asc(i)
      If b >= 48 And b <= 56 Then
         STRCONT = Mid(itext, 1, Len(itext) - num) & (i + 1) & ADDTIONZERO
         STRCONT = Trim(STRCONT)
         Exit Do
      ElseIf b = 57 Then
         ADDTIONZERO = ADDTIONZERO & "0"
         num = num + 1
      Else
         If num = 1 Then
            STRCONT = itext & "1"
         Else
            STRCONT = Mid(itext, 1, Len(itext) - (num - 1)) & 1 & Trim(ADDTIONZERO)
         End If
         Exit Do
      End If
   Loop
   AUTOINCREE_CODE = STRCONT
   Exit Function
err:
   MsgBox err.Description, vbInformation, GLOTITLE
   Exit Function
End Function
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅
2#
发表于 2007-8-14 17:00:45 | 只看该作者
哈哈,可是個好東東哦!
謝謝樓豬分享!
3#
发表于 2008-7-7 16:09:00 | 只看该作者
非常有用,谢谢
4#
发表于 2008-7-7 16:23:39 | 只看该作者
收藏[:50]
5#
发表于 2008-7-7 16:50:01 | 只看该作者
[:50] 谢谢分享!
6#
发表于 2008-8-20 19:47:36 | 只看该作者
这个函数怎么用啊,,,,请高手指点指点一个啊,,,,,[:30] [:31]
7#
发表于 2009-2-23 17:29:46 | 只看该作者
good
8#
发表于 2010-3-30 09:26:51 | 只看该作者
学习学习 
9#
发表于 2010-4-2 10:51:11 | 只看该作者
学习,收藏
10#
发表于 2010-4-2 14:03:28 | 只看该作者
粘贴在access的那里,如何引用?
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-14 14:46 , Processed in 0.090876 second(s), 33 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表