مطلوب مثال للترقيم التلقائي بالكود والاستفادة من الأرقام المحذوفة

[كوماندير]

السلام عليكم

 

اخواني الاعزاء

هلا حصلت على  مثال للترقيم التلقائي بالكود مع الاستفادة من الأرقام المحذوفة ؟

[ابا حفص]

دا كود لعمل ترقيم تلقائي باستخدام الدالة DMax كالمثال التالي اللذي يذهب الي الجدول  Table1 ويذهب الي خليه ID وياخذ اعلي قيمه لها ويضيف عليها 1 فيصبح الرقم الجديد كالكود التالي ::

Private Sub Form_Current()
DoCmd.GoToRecord , , acNewRec
Me.ID = DMax("[ID]", "Table1") + 1
End Sub

[كوماندير]

الف شكر اخي ابا حفص

 

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

[ابا حفص]

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

[rudwan]

انسخ الدالة التالية في وحدة نمطية جديدة

Public Function GetMiss() As Long

Dim sa As DAO.Recordset
Dim  mak As Long

Set sa = CurrentDb.OpenRecordset("select * from mytable order by id")

sa.MoveFirst
mak = sa![id]
GetMiss = 0
sa.MoveNext

Do Until sa.EOF



If sa![id] > mak + 1 Then
GetMiss = mak + 1
Exit Function
Else
mak = sa![id]
End If
sa.MoveNext

Loop
sa.Close
If GetMiss = 0 Then
GetMiss = mak + 1
End If
End Function

ثم عند الترقيم استخدم قيمة الدالة لتعطيك الترقيم الجديد أو الفارغ ان وجد

و بالله التوفيق

[rudwan]

طبعا يجب الانتباه هنا الى ضرورة استبدال اسم الجدول الذي لديك بدلا من  mytable

و اسم الحقل الذي يحتوي الترقيم التلقائي id

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

[ابو جودي]

انا مش قادر افهم كويس يعنى ايه المقصود من الجملة  مع الاستفادة من الأرقام المحذوفة ؟

 

 

ركز معى فى الاتى

المثال يحتوى على عدد  (2)  وحدة نمطية   
 

ـــــــــــــــالوحدة الاولى ــــــــــــــــــ
تقوم باعادة ترتيب او تصفير الترقيم التلقائى بمجرد فتح البرنامج بعد إغلاقه 

 المميزات 
ــــــــــــــــ

- تقوم بتصفير الترقيم التلقائى ككل لو تم مسح كل السجلات  

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

- الاهم من ذلك أنها تتعامل مع الحقل الخاص بالترقيم التلقائى فى الجدول وهذا ما يميز الوحدة الاولى

-تخرج التقارير من خلال الجدول بالترقيم السليم بعد اعادة ترتيبه ان اردت الترقيم من واقع الجدول يظهر فى التقرير        

العيب 
ـــــــــ
لا يتم تنفيذ الترتيب او التصفير الا بعد اغلاق البرنامج واعادة فتحه 

 

 

ـــــــــــــــــــــــــــالوحدة النمطية الثانيةـــــــــــــــــــــــــــــــ
الميزة الوحيدة 
ترى اعادة الترتيب او التصفير بمجرد اعادة تحميل النموذج فقط دون اغلاق البرنامج

امممممم
العيب
ــــــــ
غير مرتبطة بالترقيم الاصلى بجدول قاعدة البيانات  لانها ترقيم تلقائى تخيلى فقط تراه بالنموذج دون الجدول مصدر البيانات الذى اعتمد النموذج عليه فى جلب ومعالجة البيانات والعمليات


المرفق الثانى

مكون من ثلاث امثله

 

الاول -----  وحدة نمطية   ModAutoNumFixID   تعيد الترقيم التلقائى لعدد  1  جدول    A1 من خلال ماكرو  AutoExec

الثانى ----- وحدة نمطية   ModAutoNumFixID   تعيد الترقيم التلقائى لعدد  2  جدول   A1 , A2  من خلال ماكرو  AutoExec

الثالث ----- وحدة نمطية   ModAutoNumFixID   تعيد الترقيم التلقائى لعدد  3  جدول   A1 , A2 , A3  من خلال ماكرو  AutoExec

 

لاحظ الفرق بين كود الوحدة النمطية لكل مثال

المثال الاول الذى يحتوى على عدد  1  جدول

Option Compare Database
Option Explicit

Public Function Mohammed_Essam_AutoNumFix()
On Error Resume Next

Dim strSQL1, strSQL2 As String

strSQL1 = "ALTER TABLE [A1] DROP COLUMN [AutoNumber] ;" ' الجدول الأول
strSQL2 = "ALTER TABLE [A1] ADD [AutoNumber]AUTOINCREMENT;" ' الجدول الأول


DoCmd.RunSQL strSQL1 ' الجدول الأول
DoCmd.RunSQL strSQL2 ' الجدول الأول

End Function

 

 

 

المثال الثانى والذى يحتوى على عدد 2  جدول 

Option Compare Database
Option Explicit

Public Function Mohammed_Essam_AutoNumFix()
On Error Resume Next

Dim strSQL1, strSQL2, strSQL3, strSQL4 As String

strSQL1 = "ALTER TABLE [A1] DROP COLUMN [AutoNumber] ;" ' الجدول الأول
strSQL2 = "ALTER TABLE [A1] ADD [AutoNumber]AUTOINCREMENT;" ' الجدول الأول

strSQL3 = "ALTER TABLE [A2] DROP COLUMN [AutoNumber] ;" ' الجدول الثانى
strSQL4 = "ALTER TABLE [A2] ADD [AutoNumber]AUTOINCREMENT;" ' الجدول الثانى


DoCmd.RunSQL strSQL1 ' الجدول الأول
DoCmd.RunSQL strSQL2 ' الجدول الأول

DoCmd.RunSQL strSQL3 ' الجدول الثانى
DoCmd.RunSQL strSQL4 ' الجدول الثانى

End Function

 

 

 

المثال الثالث والذى يحتوى على عدد 3  جدول 

Option Compare Database
Option Explicit

Public Function Mohammed_Essam_AutoNumFix()
On Error Resume Next

Dim strSQL1, strSQL2, strSQL3, strSQL4, strSQL5, strSQL6 As String

strSQL1 = "ALTER TABLE [A1] DROP COLUMN [AutoNumber] ;" ' الجدول الأول
strSQL2 = "ALTER TABLE [A1] ADD [AutoNumber]AUTOINCREMENT;" ' الجدول الأول

strSQL3 = "ALTER TABLE [A2] DROP COLUMN [AutoNumber] ;" ' الجدول الثانى
strSQL4 = "ALTER TABLE [A2] ADD [AutoNumber]AUTOINCREMENT;" ' الجدول الثانى

strSQL5 = "ALTER TABLE [A3] DROP COLUMN [AutoNumber] ;" ' الجدول الثالث
strSQL6 = "ALTER TABLE [A3] ADD [AutoNumber]AUTOINCREMENT;" ' الجدول الثالث

DoCmd.RunSQL strSQL1 ' الجدول الأول
DoCmd.RunSQL strSQL2 ' الجدول الأول

DoCmd.RunSQL strSQL3 ' الجدول الثانى
DoCmd.RunSQL strSQL4 ' الجدول الثانى

DoCmd.RunSQL strSQL5 ' الجدول الثالث
DoCmd.RunSQL strSQL6 ' الجدول الثالث


End Function

ملاحظة هامه  

الحقل الخاص بالترقيم التلقائى إسمه فى كل الجداول  AutoNumber  ويجب الايكون مفتاح اساسى

 

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

 

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

تقبل تحياتى اخى الحبيب بكل الحب والتقدير    

 

وبعد ان اجبتك بما فهمته على قدر عقلى البسيط

فقط اهمس بود لو استخدمت البحث الخاص بالمنتدى لوجدت الكثير ولى سبيل المثال وليس الحصر انظر الرابط التالى        
http://www.officena.net/ib/index.php?app=core&module=search&do=search&fromMainBar=1

الترقيم التقائى-officena.rar

الترقيم التقائى-officena (2).rar

[كوماندير]

وصلت الافكار

 

واشكركم كثيرا على تفاعلكم

[سامي الضالعي]

السلام عليكم

هل يوجد كود يكتب لي التاريخ بالشكل التالي:

7th of May,2016

 

[صالح حمادي]

أخي سامي يجب أن تضع سؤالك في موضوع جديد فهذا يخالف قوانين المنتدى و إن شاء الله سوف نبحث لك عن حل

[حكمت العراقي]

اعتقد بامكانك وضع فورمات مناسب حسب الصيغة المطلوبة مثلا

DD "th of" mmmm,yyyy