المحافظة على الترتيب المسلسل داخل جدول

[عبد الفتاح كيرة]

السلام عليكم

أصل هذا الموضوع هنا

 

أحببت أن أفرد الرد فى موضوع مستقل لنستفيد جميعا إن شاء الله

و هو يختص بكيفية المحافظة على الترتيب داخل جدول حسب حقل المعرف

فى حال حذف أحد السجلات

و هذا هو الكود المستخدم

Option Compare Database

Private Sub Form_Current()
If Me.NewRecord Then
Dim MySQL As String, MyDB As DAO.Database, rst1 As DAO.Recordset
Dim rst2 As DAO.Recordset
 
MySQL = "Select [DashNum] From tblTest Order By DashNum;"
 
Set MyDB = CurrentDb()
Set rst1 = MyDB.OpenRecordset(MySQL, dbOpenSnapshot)
Set rst2 = rst1.Clone
 
rst1.MoveFirst: rst2.Move 1     'move to the 2nd Record in rst2
 
Do While Not rst2.EOF
  'If the difference between 2 consecutive Dash Numbers is not 1, since
  'they are ordered, this would indicate a gap in sequence
  If rst2![dashnum] <> rst1![dashnum] + 1 Then
    Me.dashnum = rst1![dashnum] + 1
      rst2.Close
      rst1.Close
      Set rst2 = Nothing
      Set rst1 = Nothing
        Exit Sub
  End If
  rst1.MoveNext
  rst2.MoveNext
Loop
 
rst2.Close
rst1.Close
Set rst2 = Nothing
Set rst1 = Nothing

End If
End Sub

المحافظة على الترتيب.rar

[abo3aesha_2014]

جزاك الله خيرا أستاذنا فهذا بالنسبة لي هي عين المطلوب 

[عبد الفتاح كيرة]

وفقكم الله

[رمهان]

لي تعقيب بسيط جدا وبعد اذنك استاذ عبدالفتاح

[sandanet]

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

[رمهان]

1. موقع الحدث في الحالي لا اعتقد مناسب حتى وان كان هناك جملة شرط ان السجل جديد . فالحدث ينطلق عند كل تنقل وخصوصا لو كبر عدد السجلات : اعتقد ان وضعه خلف الزر جديد هو انسب

2. هل جربت:

       - حذف السجل الاخير

       - ضغط زر جديد ثم التراجع ب esc  ثم الضغط مرة اخرى

      - هل جربت حذف السجل الاول وهذا هو الاهم في التعقيب

3. الموضوع اعادة الترتيب ولكن الاقرب هو "استخدام الارقام المحذوفه في الترقيم" : وهنا لابد ان يعلم المستخدم ان ما يضاف اخيرا لن يكون اخيرا بل حسب مكان ماحذف اخيرا

 

تقبل تحياتي

 

تم تعديل أبريل 26, 2017 بواسطه رمهان

[sandanet]

@رمهان

ملاحظات قوية منك استاذ رمهان .. كنت ابحث عن ملف مرفق بعد التعديل في تعقيبك اخي رمهان لكني لم اجده  

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

تم تعديل أبريل 26, 2017 بواسطه sandanet

[رمهان]

الان, sandanet said:

@رمهان

ملاحظات قوية منك استاذ رمهان .. كنت ابحث عن ملف مرفق بعد التعديل في تعقيبك اخي رمهان لكني لم اجده 

باذن الله ولكن احتاج تعقيب الاستاذ عبدالفتاح حتى اتاكد وساشارك باذن الله

تحياتي 

[عبد الفتاح كيرة]

ما هذا

أترككم ساعات فأعود لأجد كل هذه المناقشات 

وفقك الله أستاذ رمهان

لم أجرب شيئا من هذا أبدا

لك مطلق الحرية فى التعديل و التضبيط

و نحن نستفيد منك

و نحصل على الملف النهائى

شكرا لكم

[رمهان]

هذا كود لنفس فكرة الكود باول مشاركة ولكن باختصار وتخفيف على الذاكره

Private Sub ÃãÑ7_Click()
DoCmd.GoToRecord , , acNewRec
Set rs = Me.RecordsetClone: rs.MoveFirst
If rs.RecordCount = 0 Then Me.dashnum = 1: Exit Sub
For i = 1 To rs.RecordCount
If i <> rs!dashnum Then Me.dashnum = i: Exit Sub
rs.MoveNext
Next i
Me.dashnum = DMax("dashnum", "tbltest") + 1
End Sub

وطبعايمكن الاختصار اكثر بفكره اخرى

ولكن السؤال : هل ممكن بدون كود ؟

بالتوفيق

 

تم تعديل أبريل 28, 2017 بواسطه رمهان

[عبد الفتاح كيرة]

جيد

لكن كلا الكودين فيه اضطراب فى العمل

جربت الحذف ثم - بدون انتقال للسجل التالى (البقاء فى المكان)

أضغط زر الأمر لإضافة سجل

يختار رقم سجل موجود أصلا

لعله يحتاج إلى ضبط

تم تعديل أبريل 28, 2017 بواسطه عبد الفتاح كيرة

[رمهان]

11 دقائق مضت, عبد الفتاح كيرة said:

جربت الحذف ثم - بدون انتقال للسجل التالى (البقاء فى المكان)

أضغط زر الأمر لإضافة سجل

يختار رقم سجل موجود أصلا

لعلم يحتاج إلى ضبط

جربت .. ذهبت للسجل 4 ثم حذفت ثم مباشره نقرت على زر الاضافة اعطاني رقم 4

هنا تعديل بسيط فقط في الذهاب للسجل الاول

Private Sub ÃãÑ7_Click()
DoCmd.GoToRecord , , acNewRec
Set rs = Me.RecordsetClone
If rs.RecordCount = 0 Then Me.dashnum = 1: Exit Sub
rs.MoveFirst
For i = 1 To rs.RecordCount
If i <> rs!dashnum Then Me.dashnum = i: Exit Sub
rs.MoveNext
Next i
Me.dashnum = DMax("dashnum", "tbltest") + 1
End Sub

تحياتي

يمكن نحتاج Me.Requery

في بداية الكود

Private Sub ÃãÑ7_Click()
Me.Requery
DoCmd.GoToRecord , , acNewRec
Set rs = Me.RecordsetClone
If rs.RecordCount = 0 Then Me.dashnum = 1: Exit Sub
rs.MoveFirst
For i = 1 To rs.RecordCount
If i <> rs!dashnum Then Me.dashnum = i: Exit Sub
rs.MoveNext
Next i
Me.dashnum = DMax("dashnum", "tbltest") + 1
End Sub

تحياتي

[عبد الفتاح كيرة]

جارى التجربة

وفقك الله

[عبد الفتاح كيرة]

أخى رمهان

الكود تحسن

لكن لا يزال به بعض المشاكل

لا آمن أن أضع فى برامجى كودا يسبب و لو اليسير من المشاكل

هذا خطر

جزاكم الله خيرا

[رمهان]

11 ساعات مضت, عبد الفتاح كيرة said:

أخى رمهان

الكود تحسن

لكن لا يزال به بعض المشاكل

لا آمن أن أضع فى برامجى كودا يسبب و لو اليسير من المشاكل

هذا خطر

جزاكم الله خيرا

استاذ عبدالفتاح

ماهي المشاكل ؟

وانا اصلا مش مقتنع ان استخدم فكرة الدوران ! ساعود بحل مختصر ان شاء الله