اذهب الي المحتوي
أوفيسنا

الترقيم التلقائي - اعادة الضبط


الردود الموصى بها

السلام عليكم

فى المرفق حقل للترقيم التلقائي فى جميع الجداول

ارجوا اعادة الترقيم من رقم 1 

حاولت كثبرا ولم انجح

جربت امثلة من المنتدي ولم انجح

mr.rar

رابط هذا التعليق
شارك

انشئ Module  جديد و الصق فيه الشفرة التالية

Public Function ReNumber()
On Error Resume Next
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim tdf As DAO.TableDef
    Dim x As Integer
    Dim sSQL As String

    Set db = CurrentDb

    For Each tdf In db.TableDefs
        If Not (tdf.Name Like "MSys*" Or tdf.Name Like "~*" Or tdf.Name Like "exl*") Then
                sSQL = "ALTER TABLE [" & tdf.Name & "] Add [ID_New] Number"
                db.Execute sSQL
                Set rs = CurrentDb.OpenRecordset(tdf.Name)
    
            If Not rs.BOF And Not rs.EOF Then
                rs.MoveFirst
                While (Not rs.EOF)
                x = x + 1
                rs.Edit
                 rs.Fields("ID_New") = x
                 rs.Update
                    rs.MoveNext
                Wend
            End If
            rs.Close
            Set rs = Nothing

        End If
        x = 0
    Next
MsgBox "تم اضافة ترقيم لجميع الجداول بنجاح", vbInformation + vbMsgBoxRight, "تأكيد"
End Function

 

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

Call ReNumber

 

  • Like 3
رابط هذا التعليق
شارك

40 دقائق مضت, د.كاف يار said:

انشئ Module  جديد و الصق فيه الشفرة التالية

Public Function ReNumber()
On Error Resume Next
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim tdf As DAO.TableDef
    Dim x As Integer
    Dim sSQL As String

    Set db = CurrentDb

    For Each tdf In db.TableDefs
        If Not (tdf.Name Like "MSys*" Or tdf.Name Like "~*" Or tdf.Name Like "exl*") Then
                sSQL = "ALTER TABLE [" & tdf.Name & "] Add [ID_New] Number"
                db.Execute sSQL
                Set rs = CurrentDb.OpenRecordset(tdf.Name)
    
            If Not rs.BOF And Not rs.EOF Then
                rs.MoveFirst
                While (Not rs.EOF)
                x = x + 1
                rs.Edit
                 rs.Fields("ID_New") = x
                 rs.Update
                    rs.MoveNext
                Wend
            End If
            rs.Close
            Set rs = Nothing

        End If
        x = 0
    Next
MsgBox "تم اضافة ترقيم لجميع الجداول بنجاح", vbInformation + vbMsgBoxRight, "تأكيد"
End Function

 

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

Call ReNumber

 

هذا اضافة عمود جديد مرقم لجميع الجداول

ممتازة جدا عيني

  • Like 1
رابط هذا التعليق
شارك

بارك الله فيكم معلمنا الفاضل

بالفعل ينشئ id جديد

ولكن المطلوب هو تصحيح ترقيم الترقيم التلقائي فى الجداول و ليس انشاء جديد

 

رابط هذا التعليق
شارك

تفضل هذا التعديل 

***** لكن قبل البدء يجب ان يكون اسم المفتاح الاساسي هو "ID" قي كل جدول

Sub indexDelet()
Public Function ReNumber()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim tdf As DAO.TableDef
    Dim idx As ADOX.Index
    Dim x As Integer
    Dim sSQL As String, S As String

    Set db = CurrentDb

    For Each tdf In db.TableDefs
        If Not (tdf.Name Like "MSys*" Or tdf.Name Like "~*" Or tdf.Name Like "exl*") Then
                sSQL = "ALTER TABLE [" & tdf.Name & "] ALTER COLUMN [id] LONG"
                db.Execute sSQL
                Set rs = CurrentDb.OpenRecordset(tdf.Name)
    
            If Not rs.BOF And Not rs.EOF Then
                rs.MoveFirst
                While (Not rs.EOF)
                x = x + 1
                rs.Edit
                 rs.Fields("id") = x
                 rs.Update
                    rs.MoveNext
                Wend
            End If
            rs.Close
            Set rs = Nothing

        End If
        x = 0
    Next
MsgBox "تم اعادة الترقيم بنجاح", vbInformation + vbMsgBoxRight, "تأكيد"

End Function

و في ازرار اعادة الترقيم ضع التالي

Call ReNumber

 

  • Like 2
رابط هذا التعليق
شارك

تفضل التعديل

ملاحظة 

اعادة الترقيم سوف تسبب لك مشكلة كبيرة في الجداول الفرعة

لذا يجب عليك عمل نسخة احتياطية قبل البدء

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

تفضل التعديل

 

 

 

 

mr.zip

تم تعديل بواسطه د.كاف يار
  • Like 2
  • Thanks 1
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information