اريد ترقيم مسلسل معتمدا على رقم الموظف

ياريت توضح أكثر أخ أبو غدي

مثلاً إذا أردت الحصول على تاريخ الإدخال

1-اضف زر سجل جديد

2-اذهب للحدث عند النقر

3-في محرر بيزك اكتب

numberh = FormatDateTime(......

إذا هذا ماأردت ساتابع

احبتي

المشكلة هي في اعادة الترقيم

مثال :

	date_y  date_m		   date_d						mosalsal						 name
	1428	   11				  24							   1								محمد
	1428	   11				  25							   2								محمد
	1428	   11				  26							   3								محمد
	1428	   11				  27							   4								محمد
	1428	   11				  28							   5								محمد
	1428	   12				  24							   1								 خالد
	1428	   12				  25							   2								 خالد
	1428	   12				  26							   3								 خالد
	1428	   12				  27							   4								 خالد
	1428	   10				  21							   1								 علي

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

مشكلتي عند حذف احد هذه السجلات لمحمد مثلا

قلو حذفنا السجل رقم 3 اريد أن يعيد ترقيم بقية السجلات الخاصة به فقط

فيصبح رقم 4 مكان 3

و5 مكان 4 وهكذا

الآن مفهوم أخي أبو غدي

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

أن اآسف لتاخري أخي العزيز ولكن الله وحده يعلم ماذا حدث..

الآن الحل هو الآتي

classmodul1أولاَ قم بتعريف متحول في وحدة نمطية مثلا

Option Compare Database

Global delname As String

سنخزن فيه الاسم المراد حذفه

ثانياً أضف زر حذف

وادخل للكود في حدث عند النقر وفي بداية الكود من الأول اكتب

delname = me!name

وهذا يعني أننا سنضع الاسم ونخزنه في المتحول العمومي قبل عملية الحذف

ثالثاً:

اختر النموذج(فورم واذهب للحدث بعد الحذف

after delete

واكتب الكود التالي

Private Sub Form_Delete(Cancel As Integer)
Dim rds As DAO.Recordset
Dim i As Integer

Set rds = CurrentDb.OpenRecordset("em_gheyab", dbOpenDynaset)
i = 1
rds.MoveFirst
rds.Findfirst ("name = " & "'" & delname & "'")
rds.Edit
rds!mosalsal =1
rds.Update
Do While not rds.eof 'Search for the first matching record
rds.FindNext ("name = " & "'" & delname & "'")
If Not rds.NoMatch Then 'تم إيجاد سجل آخر
i = i + 1
rds.Edit
rds!mosalsal = i
rds.Update
else exit
end if
Loop
rds.Close
Set rds = Nothing
End Sub

)

حسنا ماذا يعني الكود السابق

أولا عرفنا متحول من نوع recordset وفتحنا من خلاله جدولنا

بحثنا عن المطابقة الاولى مع المتحول العمومي الذي خزنا فيه الاسم المحذوف

واسندنا لرقمه المتسلسل القيمة واحد

بدانا حلقة while تنتهي عند تحقق أحد الشرطين إما نهاية سجلات الجدول

أو عند عدم وجود مطابقة ثانية

وفي حال تم إيجاد سجل مطابق داخل الحلقة تضاف القيمة واحد إلى رقم المتسلسل

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

سازودك لاحقا بالمثال

ولكن جرب هذا الكود

جزاك الله كل خير اخي الطارق

انا في انتظارك

للرفع يا شباب

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

اننا بحاجة لتوضيح معيار التكرار للاسم، اي هل يخزن الاسم كاملا ام فقط الاسم الاول للشخص،،

وهذا يمكن ان يسهل استخدام الدالة Dcount لعد التكرارت وعمل رقم مسلسل لكل اسم على حدة...

همام

أخي الحبيب همام

خانة الاسم ستحتوي على الاسم كاملا

ويمكن الاستغناء عنه برقم الموظف numberh

فلو عملت الدالة على رقم الموظف فهو افضل

اخي الطارق

الف شكر على مجهودك

ولكن الكود لم يعمل معي بالشكل الصحيح ولا ادري لماذا؟

هل من الممكن التعديل على المثال المرفق

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

للرفع

تكفون يا شباب

أخي أبو غدي كان الحل أمامك ولم تراه كل شيئ سليم باستثناء سطر واحد كان عليك أن تغير فقط العبارة

else exit

بالعبارة

else: exit sub

ولكن لايهمك

الآن الحل هو الآتي

وسمه classmodul1أولاَ قم بتعريف متحول عمومي في وحدة نمطية مثلا

delnameكما يلي

Option Compare Database

Global delname As String

سنخزن فيه الاسم المراد حذفه

ثانياً أضف زر حذف سجل على تصميم النموذج

وادخل للكود في حدث عند النقر وفي بداية الكود من الأول اكتب

delname = me!name

كما يلي:

Private Sub ÃãÑ22_Click()
On Error GoTo Err_ÃãÑ22_Click
'her iput mycod
delname = Me!name
'-----------
	DoCmd.RunCommand acCmdSelectRecord
	DoCmd.RunCommand acCmdDeleteRecordExit_ÃãÑ22_Click:
	Exit SubErr_ÃãÑ22_Click:
	MsgBox Err.Description
	Resume Exit_ÃãÑ22_Click

End Sub

وهذا يعني أننا سنضع الاسم ونخزنه في المتحول العمومي قبل عملية الحذف

ثالثاً:

اختر النموذج(فورم واذهب للحدث بعد تأكيد الحذف

after confirm delet delete

واكتب الكود التالي

Private Sub Form_AfterDelConfirm(Status As Integer)
Dim rds As DAO.Recordset
Dim i As IntegerSet rds = CurrentDb.OpenRecordset("em_gheyab", dbOpenDynaset)
i = 1
rds.MoveFirst
rds.FindFirst ("name = " & "'" & delname & "'")
rds.Edit
rds!mosalsal = 1
rds.Update
Do While Not rds.EOF 'Search for the first matching record
rds.FindNext ("name = " & "'" & delname & "'")
If Not rds.NoMatch Then 'we find on match
i = i + 1
rds.Edit
rds!mosalsal = i
rds.Update
'else exit
'كان عليك تغيير العبارة أعلاه بالعبارة أدناه فقط
Else: Exit Sub
End If
Loop
rds.Close
Set rds = Nothing
End Sub

حسنا ماذا يعني الكود السابق

أولا عرفنا متحول من نوع recordset وفتحنا من خلاله جدولنا

بحثنا عن المطابقة الاولى مع المتحول العمومي الذي خزنا فيه الاسم المحذوف

واسندنا لرقمه المتسلسل القيمة واحد

بدانا حلقة while تنتهي عند تحقق أحد الشرطين إما نهاية سجلات الجدول

أو عند عدم وجود مطابقة ثانية

وفي حال تم إيجاد سجل مطابق داخل الحلقة تضاف القيمة واحد إلى رقم المتسلسل

حمل المرفق معدلا يعمل من هنا وقد جربته:db1.rar

:cash:

اخي الكريم

خانة الرقم moslsal لم يحدث فيها تغيير وهي المطلوبة

احذف أي سجل من النص ولا يتغير الترقيم

يبقى كما هو

ليس صحيحا أخي

أحذف اي سجل مثلا لصالح ستجد أنه أعاد ترقيم سجلات صالح مرة ثانية من 1-2-3....

لكن انتبه إلى أي سجل حذفت جرب البرنامج

مثلا

1صالح

2صالح

3صالح

4صالح

فاذا حذفت السجل الثالث سيصبح السجلات هكذا

1صالح

2صالح

4صالح

لكن الآن بعد تنزيل الكود سيصبح كمايلي الترتيب

1صالح

2صالح

3صالح

أي أنه أعد الترقيم من البداية وعدل قيم الرقم mosalsal

أليس هذا ماقصدته من البداية

وهذه خطوات مشروحة

أنا في انتظار ردك..

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

انا استخدم اوفيس 2003

ولا زلت احاول ولكن لا يعيد الترقيم نهائيا

لاحظ الصور في المرفقات

aa.bmp

bb.bmp

وفيه مشكلة اذا حذفت السجل الوحيد او الأول

rds.MoveFirst

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

وياريت تضع القاعدة الاساسية التي تعمل عليها ليتم تضمين الكود بالشكل الصحيح وفقكم الله جميعاًَ

أخي الطارق

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

اسف جدا تعبتك معاي

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

بقي مشكلة واحدة وهي عند حذف السجل الوحيد

بعد حذف السجل يعطيني run-time error 3021

لا يوجد السجل الحالي[

للرفع