محتاج كود لاعادة الترقيم التلقائي

[2saad]

إخواني الأعزاء أعضاء المنتدي الكرام بعد سلام الله عليكم ورحمة الله وبركاته

محتاج كود لإعادة الترقيم التلقائي من الجدول الرئيسي بعد حذف بعض السجلات منه

ولكم جزيل الشكر

[عمر ضاحى]

4 ساعات مضت, 2saad said:

إخواني الأعزاء أعضاء المنتدي الكرام بعد سلام الله عليكم ورحمة الله وبركاته

محتاج كود لإعادة الترقيم التلقائي من الجدول الرئيسي بعد حذف بعض السجلات منه

ولكم جزيل الشكر

اتفضل هذا الدالة تفي بالغرض ان شاء الله 
 

Function ResetAutoNo(ByVal TableName As String, ByVal FieldName As String)
On Error GoTo ErrorHandler
    
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim idx As DAO.Index
    Dim fld As DAO.Field
    Dim wasPrimaryKey As Boolean
    Dim pkName As String
    
    Set db = CurrentDb
    Set tdf = db.TableDefs(TableName)
    
    wasPrimaryKey = False
    For Each idx In tdf.Indexes
        If idx.Primary Then
            If idx.Fields(0).Name = FieldName Then
                wasPrimaryKey = True
                pkName = idx.Name
                tdf.Indexes.Delete pkName
                Exit For
            End If
        End If
    Next idx

    tdf.Fields.Delete FieldName

    Set fld = tdf.CreateField(FieldName, dbLong)
    fld.Attributes = fld.Attributes Or dbAutoIncrField
    tdf.Fields.Append fld
    
    If wasPrimaryKey Then
        Set idx = tdf.CreateIndex(pkName)
        idx.Fields.Append idx.CreateField(FieldName)
        idx.Primary = True
        tdf.Indexes.Append idx
    End If
    db.TableDefs.Refresh

    Set fld = Nothing
    Set tdf = Nothing
    Set db = Nothing
    
    Debug.Print "تم إعادة تعيين حقل الرقم التلقائي بنجاح"
    
    
ErrorHandler:
        If Err.Number = 0 Then
        ElseIf Err.Number = 3265 Then
            MsgBox "تحقق من اسم الجدول أو اسم الحقل", vbExclamation, "خطأ"
            Exit Function
        ElseIf Err.Number = 3211 Then
            MsgBox "الجدول تم تحريره او هناك مستخدم يستخدمه", vbExclamation, "خطأ"
            Exit Function
        Else
            MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "خطأ غير متوقع"
        End If
End Function

 

طريقة العمل 
 

Call ResetAutoNo("tbl_Name", "ID")

على اساس ان ID هو اسم الحقل الترقيم التلقائى 

و tbl_name هو اسم الجدول

تم تعديل أغسطس 23 بواسطه عمر ضاحى

[2saad]

شكرا جزيلا أخي الكريم وبارك الله فيك

 أين أضع هذا الكود ؟

[عمر ضاحى]

2 ساعات مضت, 2saad said:

شكرا جزيلا أخي الكريم وبارك الله فيك

 أين أضع هذا الكود ؟

ضع الكود فى مديول 
واستدعيه بالطريقة التى تم توضيحها
واذا كانت الاجابة صحيحه اختر افضل اجابة لغلق الموضوع