اخوي بارك الله فيك
ضع الكود التالي في وحده نمطية جديده
Sub SetAutoNumber(sTable As String, ByVal lNum As Long)
On Error GoTo Err_SetAutoNumber
' Purpose: set the AutoNumber field in sTable to begin at lNum.
' Arguments: sTable = name of table to modify.
' lNum = the number you wish to begin from.
' Sample use: Call SetAutoNumber("tblInvoice", 1000)
Dim db As DAO.Database ' Current db.
Dim tdf As DAO.TableDef ' TableDef of sTable.
Dim i As Integer ' Loop counter
Dim fld As DAO.Field ' Field of sTable.
Dim sFieldName As String ' Name of the AutoNumber field.
Dim vMaxID As Variant ' Current Maximum AutoNumber value.
Dim sSQL As String ' Append/Delete query string.
Dim sMsg As String ' MsgBox string.
lNum = lNum - 1 ' Assign to 1 less than desired value.
' Locate the auto-incrementing field for this table.
Set db = CurrentDb()
Set tdf = db.TableDefs(sTable)
For i = 0 To tdf.Fields.Count - 1
Set fld = tdf.Fields(i)
If fld.Attributes And dbAutoIncrField Then
sFieldName = fld.name
Exit For
End If
Next
If Len(sFieldName) = 0 Then
sMsg = "No AutoNumber field found in table """ & sTable & """."
MsgBox sMsg, vbInformation, "Cannot set AutoNumber"
Else
vMaxID = DMax(sFieldName, sTable)
If IsNull(vMaxID) Then vMaxID = 0
If vMaxID >= lNum Then
sMsg = "Supply a larger number. """ & sTable & "." & _
sFieldName & """ already contains the value " & vMaxID
MsgBox sMsg, vbInformation, "Too low."
Else
' Insert and delete the record.
sSQL = "INSERT INTO " & sTable & " ([" & sFieldName & "]) SELECT " & lNum & " AS lNum;"
db.Execute sSQL, dbFailonerror
sSQL = "DELETE FROM " & sTable & " WHERE " & sFieldName & " = " & lNum & ";"
db.Execute sSQL, dbFailonerror
End If
End If
Exit_SetAutoNumber:
Exit Sub
Err_SetAutoNumber:
MsgBox "Error " & Err.Number & ": " & Err.Description, , "SetAutoNumber()"
Resume Exit_SetAutoNumber
End Sub
ثم قم بالحفظ باي اسم ترغب
ثم قم بفتح شاشه تففيذ الاكواد المباشره وذلك عن طريق ضغط زر G+Ctrl
بعد ذلك قم بوضع الكود التالي في هذه الشاشه
Call SetAutoNumber("tblName", 6510)
طبع الرقم الموجود في هذا السطر هو الرقم الذي ترغب بداء الترقيم منه
وكذلك لابد من تحديد اسم الجدول واستبداله مكان tblName و يفضل استخدام اللغه الانجليزيه
ثم اضغط زر Enter
شاهد المرفق
بالتوفيق
numbering.rar