Office中国论坛/Access中国论坛

标题: [已解决]请帮忙看下这个自动编号问题 [打印本页]

作者: sunny-xie 时间: 2007-12-7 15:08
标题: [已解决]请帮忙看下这个自动编号问题
以下这段代码执行的结果是同一天（如2007-12-7）取号自动生成PO-0712001,PO-0712002,PO-0712003...的效果，但是到了2007-12-8这天，自动生成的号码又变会PO-0712001....PO-071200N，

要让他在同一个月内号码连续，（如在12月份，号码是PO-0712001,PO-071200N,但到了2008-01-01时，号码就变为PO-0801001,PO-080100N,应该如何修改，请达人指教，谢谢了！

Private Sub Form_BeforeInsert(Cancel As Integer)
On Error GoTo Err_Form_BeforeInsert
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strSQL As String
Dim lngID 'As Long
lngID = DLookup("AutoNum", "tbl编号", "Date=#" & Date & "#")
If IsNull(lngID) Then
Set conn = CurrentProject.Connection
strSQL = "SELECT * FROM tbl编号;"
rs.Open strSQL, conn, adOpenDynamic, adLockOptimistic
      rs.AddNew
      rs("AutoNum") = 0
      rs("Date") = Date
      rs.Update
rs.Close
Set rs = Nothing
Set conn = Nothing
lngID = 0
End If
Me.PO单号 = Format("PO-") & Format(Date, "yymm") & Format(lngID + 1, "000")
Exit_Form_BeforeInsert:
Exit Sub
Err_Form_BeforeInsert:
MsgBox Err.Description
Resume Exit_Form_BeforeInsert
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
On Error GoTo Err_Form_BeforeUpdate
Dim intVal As Integer
intVal = MsgBox("是否保存？单击否将撤销本次输入。", vbYesNo + vbQuestion + vbDefaultButton1, "fan0217")
If intVal = vbYes Then
MsgBox "保存成功！", 64, "fan0217"
If Me.NewRecord = True Then
      Dim conn As New ADODB.Connection
      Dim rs As New ADODB.Recordset
      Dim strSQL As String

      Set conn = CurrentProject.Connection
      strSQL = "SELECT * FROM tbl编号 WHERE Date=#" & Date & "#;"
      rs.Open strSQL, conn, adOpenDynamic, adLockOptimistic
         rs("AutoNum") = CInt(Right(Me.PO单号, 3))
         rs.Update
      rs.Close
      Set rs = Nothing
      Set conn = Nothing
End If
Else
Me.Undo
End If
Exit_Form_BeforeUpdate:
Exit Sub
Err_Form_BeforeUpdate:
MsgBox Err.Description
Resume Exit_Form_BeforeUpdate
End Sub

[ 本帖最后由 cuxun 于 2007-12-12 07:23 编辑 ]

作者: sunny-xie 时间: 2007-12-7 15:18
原来是20071207001这样效果的，
现要修改为PO-0712001..PO-071200N，PO-0801001..PO-080100N这样的效果

作者: sunny-xie 时间: 2007-12-8 08:58
[attach]27154[/attach]

我把库上传，请看库，

现在的问题是同一天的取号是连续的，但是隔一天后，取号又重复

作者: Victor_Duane 时间: 2007-12-8 09:23
是不是需要一个这样的函数
'===============================================================================
'-函数名称:       autoID
'-功能描述:       自动编号 ,
'-输入参数说明:    参数1:tblname 表名
'                参数2:fldname 字段名
'                参数3:intlength增长号的长度
'                参数4:prefix 前缀(可选参数)
'                参数5:dateformat时间前缀(可选参数)
'-返回参数说明:    可以按时间自增长编号, 如果没有时间就自增长编号
'-使用语法示例:    AutoID("型体编号表", "型体编号", 4, "GL")
'                AutoID("型体编号表", "型体编号", 4)
'                AutoID("型体编号表", "型体编号", 4, "GL","yyyymmdd")
'-参考:
'-使用注意:
'-兼容性:          2000,XP,2003
'-作者:          Victor Duane
'-更新日期：       2007-12-5 17:03
'===============================================================================
Function AutoID(tblName As String, fldName As String, intLength As Integer, Optional Prefix As String = "", Optional DateFormat As String = "") As String
'自动编号 , 可以按时间自增长编号, 如果没有时间就自增长编号
Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection

Dim intDate As Integer
Dim intPrefix As Integer

Dim strDate As String
Dim strToday As String
Dim OldDate As String

'如果DateFormat为空,当天日期为空,否则为当天日期
If Len(DateFormat) = 0 Then
strToday = ""
Else
strToday = Format(Date, DateFormat)
End If

strDate = strToday
intDate = Len(strDate) '取得时间的长度
intPrefix = Len(Prefix) '取得前缀的长度

Set cn = CurrentProject.Connection
Dim strSQL As String
strSQL = "select * from " & tblName & " order by " & fldName
rs.Open tblName, cn, 1, 2

Debug.Print rs.RecordCount
If rs.RecordCount > 0 Then
rs.MoveLast
'取得最大值的时间前缀
OldDate = Nz(Mid$(rs(fldName), intPrefix + 1, intDate), "")
'判断新增的值是否跨时间
If strToday = OldDate Then
      AutoID = Prefix & strDate & Format(Val(Right$(rs(fldName), intLength) + 1), String(intLength, "0"))
Else
      AutoID = Prefix & strDate & String(intLength - 1, "0") & "1"
End If
Else
AutoID = Prefix & strDate & String(intLength - 1, "0") & "1"
End If

rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
End Function

作者: Victor_Duane 时间: 2007-12-8 09:47
如果是要写在绑定数据窗体里
Private Sub Form_Current()
if me.newrecord then
me.id=AutoID("tbl客户", "po编号", 3, "PO-","yymm")
end if
end sub

作者: sunny-xie 时间: 2007-12-8 10:12
标题: 回复 6# 的帖子
斑竹有没有调试过？
加上代码后，编号不会变动啊

烦请用我的库举个例子，谢谢了！

作者: sunny-xie 时间: 2007-12-8 10:55
标题: 回复 9# 的帖子
效果实现，非常感谢斑竹！

原代码的格式其实是按PO-年月日000这样的，我以为改成这样就可以Me.PO单号 = Format("PO-") & Format(Date, "yymm") & Format(lngID + 1, "000")，结果同一天里可以，过一天，编号就重复了

Private Sub 命令1_Click()
On Error GoTo Err_命令1_Click
Dim StrDate As String
Dim TempNum As Integer

DoCmd.GoToRecord , , acNewRec

StrDate = Format(Date, "yymm")

TempNum = Mid(Nz(DMax("po单号", "tbl客户", "mid(po单号,4,4)='" & StrDate & "'"), "000000000"), 8)

Me.PO单号 = "P0-" & StrDate & Format(TempNum + 1, "000")

Exit_命令1_Click:
Exit Sub

Err_命令1_Click:
MsgBox Err.Description
Resume Exit_命令1_Click

End Sub

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)