اريد عمل ترقيم مسلسل

للرفع يا شباب

اخي الفاضل ابو غدي

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

وكل عام وانتم بخير بمناسبة شهر رمضان المبارك

لعمل ترقيم تلقائي كل ما عليك هو اتباع الخطوات التالية

1. انشاء جدول وليكن اسمه مثلا Table وضع به الحقول المطلوبه

2. انشئ استعلام مبني على الجدول وليكن اسم الاستعلام مثلا QrST

3. انشئ وحده نمطية جديده وضع بها هذا الكود

Function RcNumq1(mID As Variant, fldName As String) As Variant
Dim RstClone As Recordset
Dim Fld As Field
Dim I As Long
RcNumq = Null
If IsNull(mID) Then Exit Function
Set RstClone = CurrentDb.QueryDefs("QrST").OpenRecordset
If RstClone.RecordCount = 0 Then Exit Function
Set Fld = RstClone.Fields(fldName)
With RstClone
.MoveFirst
Do Until .EOF
I = I + 1
If Fld = mID Then Exit Do
.MoveNext
Loop
End With
RstClone.Close
RcNumq1 = I
End Function

لاحظ اسم الاستعلام QrST في الوظيفة RcNumq1

4. انتقل الان الى الاستعلام وافتحه في عرض التصميم وقم بإضافة تعبير جديد مثلا عدد وضع به التعبير التالي

عدد: RcNumq1([الاسم];"الاسم")

5. قم بإنشاء نموذج مبني على الجدول ثم قم بوضع مربع نص غير منظم ومصدره يكون خانة او حقل "عدد " من الاستعلام

6. قم بالتجربه في النموذج وذلك بحذف عدد من السجلات بطريقة عشوائية اي من الاول ومن الوسط ومن الاخير وستجد ان الترقيم التلقائي لا يتأثر ابدا بل تقوم الدالة بالتعويض مباشره عن الارقام المحذوفه وترتيب الارقام مباشره بطريقه متسلسله .

وهذا مثال على هذه الطريقه

الترقيم التلقائي.rar

اختكم

زهره

وفقك الله يا أحت زهرة ونفع بك وبعلمك

هذا بالضبط ما كنت ابحث عنه

شاكر لتعاونك