ترقيم حقل بشرط قيمة من حقل اخر

[ابو هاله النبلسي]

السلام عليكم ورحمة الله وبركاته 

في الجدول حقل اسم المدرسة وحقل اسمه t1 المطلوب ترقم الحقل t1 حسب اسم المدرسة يعني مثلا اسم المدرسة النصر ثلاث سجلات يتم ترقيمها من 1 الى 3 وهكذا لبقيه المدارس 

New Microsoft Access Database.rar

[Moosak]

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

 

ماهو هدفك من الترقيم بهذه الطريقة ؟

لعله توجد طريقة أفضل من هذه بإنشاء جدول آخر يتم وضع فيه السجلات الخاصة بكل مدرسة .. 🙂 

[ابو هاله النبلسي]

استاذي العزيز لا احتاج جدول احتاج فقط الترقيم وشاكر لك  وفي حالة تم حذف سجل وتم اضافة سجل من نفس المدرسة يعطيني ترقيم جديد 

تم تعديل مارس 22, 2022 بواسطه ابو عبد الرحمن العراقي

[Moosak]

في هذه الحالة هذي تُعمل في فورم وليس في الجدول مباشرة ..

تضع هذا الكود في حدث بعد التحديث لاسم المدرسة :

Private Sub اسم_المدرسة_AfterUpdate()

Dim N As Integer

N = Nz(DMax("t1", "جدول1", "[اسم المدرسة]='" & Me.اسم_المدرسة & "'") + 1, 1)
Me.t1 = N

End Sub

بشرط كتابة اسم المدرسة بشكل صحيح لكي يتعرف عليه الكود .

وعند إضافة سجل جديد سيعطيك الرقم التالي لأكبر رقم مسجل في الجدول لنفس المدرسة 🙂 

New Microsoft Access Database.accdb

تم تعديل مارس 22, 2022 بواسطه Moosak

[ابو هاله النبلسي]

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

تم تعديل مارس 22, 2022 بواسطه ابو عبد الرحمن العراقي

[Moosak]

3 ساعات مضت, ابو عبد الرحمن العراقي said:

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

الله يبارك فيك أخي أبو عبدالرحمن .. 🌹

هل جربت المرفق ؟ .. كود ال VBA  الذي وضعته لك يقوم بما ذكرته .

أم تقصد أنك تريد طريقة لإعادة ترقيم أسماء المدارس السابقة في قاعدة البيانات لديك ؟

[ابو هاله النبلسي]

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

[Moosak]

منذ ساعه, ابو عبد الرحمن العراقي said:

انا احتاج يعطيني الترقيم بضغطة زر واحده لكل السجلات

تم التعديل أخي أبو عبدالرحمن كما طلبت .. وأبقيت على الكود السابق لكي يعمل تلقائيا عند إضافة سجل جديد ..

أولا قمت بتغيير أسماء جميع العناصر والحقول إلى اللغة الإنجليزية لكي يسهل التعامل مع الأكواد 🙂 

ثم أضفت هذا الكود على زر إعادة الترقيم  :

Private Sub ReNumbringBtn_Click()

Dim DB As dao.Database
Dim RS As dao.Recordset

Set DB = CurrentDb
Set RS = DB.OpenRecordset("Table1")

' تصفير الأرقام للبدأ من جديد
DoCmd.SetWarnings False
DoCmd.RunSQL ("update table1 set t1 = 0")
DoCmd.SetWarnings True

' إعادة الترقيم
With RS
    .MoveFirst
    Do Until .EOF
        .Edit
        !t1 = Nz(DMax("t1", "Table1", "[SchoolName]='" & !SchoolName & "'") + 1, 1)
        .Update
        .MoveNext
    Loop
End With

Set DB = Nothing
Set RS = Nothing

DoCmd.OpenTable "table1"
MsgBox "تم ترقيم المدارس بنجاح", vbOKOnly, "انتهى"

End Sub

والآن يمكنك تجربته ولا تنسى تغيير المسميات التي في الكود لتوافق المسميات الموجودة لديك 🙂

المرفق :

Numbring.accdb

تم تعديل مارس 22, 2022 بواسطه Moosak

[ابو هاله النبلسي]

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

[Moosak]

العفو أخي أبا عبدالرحمن 🙂