أجعل الترقيم التلقائي يبدأ من 1000

[البـدر]

قمت أولاً بإنشاء ملف بالأكسل ورقمت أحد الأعمدة من واحد إلى ألف ثم حفظت الملف بأسم، وبعد ذلك ذهب إلا الاكسس وجلبت الملف وحفظت كجدول باسم ثم أضفت له حقل آخر(ترقيم تلقائي) فتلقائياً وضع ترقيم إلى ألف بعد ذلك قمت بحذفت السجلات التي قبل الألف .. والحمد لله انحلت المشكلة .

وعلى ما يقولون الحاجة أم الإختراع

والسؤال :

هل توجد طريقة أفضل من هذه الطريقة المعقدة .

[osama457]

هذا كود بسيط يلبي حاجتك

يحتاج تعدل فيه كلمة t1 باسم الجدول عندك

وكلمة TheId باسم حقل الترقيم التلقائي فيه

Function SpecialAutoNumber(InNumber As Long)
InNumber = InNumber - 1
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO t1 ( TheId ) SELECT " & InNumber & " AS Expr1;"
DoCmd.RunSQL "DELETE t1.*, t1.TheId FROM t1 WHERE (((t1.TheId)=" & InNumber & "));"
DoCmd.SetWarnings True
End Function

وهو عن طريق استعلام اضافه ثم استعلام حذف موجود في المثال المرفق مع كود افضل منه باستخادم DAO وهو :

Function SpecialAutoNumberByDAO(InNumber As Long)
On Error GoTo Description_Of_Err
Dim dbs As Database
Dim rst As Recordset
InNumber = InNumber - 1
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("t1", dbOpenDynaset)
With rst
    If rst.RecordCount <> 0 Then
        .FindFirst "[TheId]>" & InNumber
        If Not .NoMatch Then
            MsgBox "لم يتم تعديل الترقيم التلقائي" & vbCrLf & _
            "لوجود رقم أكبر أو مساوي للرقم المدخل", , ""
            GoTo LastFunction
        End If
    End If
    
    .AddNew
    !TheId = InNumber
    .Update
    
    .MoveFirst
    .FindFirst "[TheId]=" & InNumber
    .Delete
End With

LastFunction:
rst.Close
Set rst = Nothing
Set dbs = Nothing
Exit Function

Description_Of_Err:
If Err.Number <> 3022 Then
    MsgBox Err.Number & vbCrLf & Err.Description, , "Error"
Else
   'MsgBox Err.Number
    GoTo LastFunction
End If
End Function

from1000_22.zip

تم تعديل مارس 7, 2004 بواسطه osama457