[求助]0711001这样的自动编号如何做？

sunny-xie

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

效果：在库中窗体  窗体1 的 单号处，自动显示编号YYMM001(YY为年份，MM为月份，001为单号流水号)每按添加一次，流水号递增，但是年份和月份也要随着系统日期变更，也就是07年12月1日时，0712001，08年01月01日时，0801001依次类推。

请达人指教，THKS！

Victor_Duane

下面这段代码，就是如何在窗体中使用的方法
Private Sub Command4_Click()
Dim rs As New ADODB.Recordset
rs.Open "型体编号表", CurrentProject.Connection, 1, 3
rs.AddNew
rs("型体编号") = Me.型体编号
rs.Update
rs.Close
Set rs = Nothing
Me.型体编号 = Null
Me.型体编号 = uf_AutoNum("型体编号表", "型体编号")

End Sub

Private Sub Form_Load()
Me.型体编号.Enabled = True

Me.型体编号 = uf_AutoNum("型体编号表", "型体编号")

Me.型体编号.Enabled = False
Me.文本1.SetFocus
End Sub


'使用方法:Me.型体编号 = uf_AutoNum("型体编号表", "型体编号")
Function uf_AutoNum(strTable As String, strfldName As String)
'strtable 表名
'strfldname 字段名
Dim rst As New ADODB.Recordset
rst.Open strTable, CurrentProject.Connection, 1, 3
Dim strYY As String
Dim strMaxNum As String
Dim strMidYY As String
Dim strMidNum As String
strYY = Format(Date, "YY")
Debug.Print rst.RecordCount
If rst.RecordCount > 0 Then
    strMaxNum = DMax(strfldName, strTable)
    Debug.Print strMaxNum
    strMidYY = Mid(strMaxNum, 3, 2)
    strMidNum = Format(Val(Right(strMaxNum, 3)) + 1, "000")

        If strMidYY = strYY Then
            uf_AutoNum = "GL" & strYY & strMidNum
        Else
            uf_AutoNum = "GL" & strYY & "001"
        End If
Else
    uf_AutoNum = "GL" & strYY & "001"
End If
rst.Close
Set rst = Nothing

End Function

sunny-xie

下面这段代码效果如何？断号问题，怎么处理？
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

sunny-xie

我那时在浏览这里的帖子，发错地方。。

小宜

学习学习学习学习学习

sszssz

注册会员



个人空间 发短消息 加为好友 当前离线  6# 大 中 小 发表于 2007-11-30 20:09  只看该作者
学习学习

tdhgj

good

twins

要学习啊

kn1394

try

kn1394

try