请达人指教，THKS！作者: Victor_Duane 时间: 2007-11-29 23:30
下面这段代码，就是如何在窗体中使用的方法
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 时间: 2007-11-30 08:54
下面这段代码效果如何？断号问题，怎么处理？
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 时间: 2007-11-30 08:59 标题: 回复 2# 的帖子 我那时在浏览这里的帖子，发错地方。。作者: 小宜 时间: 2007-11-30 20:09
学习学习学习学习学习作者: sszssz 时间: 2008-12-14 12:10
注册会员
