محمد قاسم 12 قام بنشر سبتمبر 8, 2021 مشاركة قام بنشر سبتمبر 8, 2021 السلام عليكم فى المرفق حقل للترقيم التلقائي فى جميع الجداول ارجوا اعادة الترقيم من رقم 1 حاولت كثبرا ولم انجح جربت امثلة من المنتدي ولم انجح mr.rar رابط هذا التعليق شارك More sharing options...
د.كاف يار قام بنشر سبتمبر 8, 2021 مشاركة قام بنشر سبتمبر 8, 2021 انشئ Module جديد و الصق فيه الشفرة التالية Public Function ReNumber() On Error Resume Next Dim db As DAO.Database Dim rs As DAO.Recordset Dim tdf As DAO.TableDef Dim x As Integer Dim sSQL As String Set db = CurrentDb For Each tdf In db.TableDefs If Not (tdf.Name Like "MSys*" Or tdf.Name Like "~*" Or tdf.Name Like "exl*") Then sSQL = "ALTER TABLE [" & tdf.Name & "] Add [ID_New] Number" db.Execute sSQL Set rs = CurrentDb.OpenRecordset(tdf.Name) If Not rs.BOF And Not rs.EOF Then rs.MoveFirst While (Not rs.EOF) x = x + 1 rs.Edit rs.Fields("ID_New") = x rs.Update rs.MoveNext Wend End If rs.Close Set rs = Nothing End If x = 0 Next MsgBox "تم اضافة ترقيم لجميع الجداول بنجاح", vbInformation + vbMsgBoxRight, "تأكيد" End Function و في النموذج ازرار اعادة ترقيم ضع الأمر التالي Call ReNumber 3 رابط هذا التعليق شارك More sharing options...
abouelhassan قام بنشر سبتمبر 8, 2021 مشاركة قام بنشر سبتمبر 8, 2021 استاذى الحبيب الغالى لقلبى د.كاف يار طبقت كل المكتوب بالضبط ولا يتم ارجاع الترقيم التلقائى بارك الله فيك وبك ولك اللهم امين احترامى ترقيم تلقائى كود.accdb 2 رابط هذا التعليق شارك More sharing options...
طلب اكسس قام بنشر سبتمبر 8, 2021 مشاركة قام بنشر سبتمبر 8, 2021 40 دقائق مضت, د.كاف يار said: انشئ Module جديد و الصق فيه الشفرة التالية Public Function ReNumber() On Error Resume Next Dim db As DAO.Database Dim rs As DAO.Recordset Dim tdf As DAO.TableDef Dim x As Integer Dim sSQL As String Set db = CurrentDb For Each tdf In db.TableDefs If Not (tdf.Name Like "MSys*" Or tdf.Name Like "~*" Or tdf.Name Like "exl*") Then sSQL = "ALTER TABLE [" & tdf.Name & "] Add [ID_New] Number" db.Execute sSQL Set rs = CurrentDb.OpenRecordset(tdf.Name) If Not rs.BOF And Not rs.EOF Then rs.MoveFirst While (Not rs.EOF) x = x + 1 rs.Edit rs.Fields("ID_New") = x rs.Update rs.MoveNext Wend End If rs.Close Set rs = Nothing End If x = 0 Next MsgBox "تم اضافة ترقيم لجميع الجداول بنجاح", vbInformation + vbMsgBoxRight, "تأكيد" End Function و في النموذج ازرار اعادة ترقيم ضع الأمر التالي Call ReNumber هذا اضافة عمود جديد مرقم لجميع الجداول ممتازة جدا عيني 1 رابط هذا التعليق شارك More sharing options...
طارق عبد الرازق قام بنشر سبتمبر 8, 2021 مشاركة قام بنشر سبتمبر 8, 2021 د.كاف يار مشكور وجزاك الله خير رائع ودائماً بنتعلم منك 1 رابط هذا التعليق شارك More sharing options...
محمد قاسم 12 قام بنشر سبتمبر 8, 2021 الكاتب مشاركة قام بنشر سبتمبر 8, 2021 بارك الله فيكم معلمنا الفاضل بالفعل ينشئ id جديد ولكن المطلوب هو تصحيح ترقيم الترقيم التلقائي فى الجداول و ليس انشاء جديد رابط هذا التعليق شارك More sharing options...
Eng.Qassim قام بنشر سبتمبر 8, 2021 مشاركة قام بنشر سبتمبر 8, 2021 السلام عليكم معلومة.. في حالة حذف السجل الاخير وحتى لايعبر الترقيم الرقم الاخير .. نقوم بعمل ضغط واصلاح للقاعدة 1 رابط هذا التعليق شارك More sharing options...
محمد قاسم 12 قام بنشر سبتمبر 8, 2021 الكاتب مشاركة قام بنشر سبتمبر 8, 2021 هل من حل رابط هذا التعليق شارك More sharing options...
د.كاف يار قام بنشر سبتمبر 9, 2021 مشاركة قام بنشر سبتمبر 9, 2021 تفضل هذا التعديل ***** لكن قبل البدء يجب ان يكون اسم المفتاح الاساسي هو "ID" قي كل جدول Sub indexDelet() Public Function ReNumber() Dim db As DAO.Database Dim rs As DAO.Recordset Dim tdf As DAO.TableDef Dim idx As ADOX.Index Dim x As Integer Dim sSQL As String, S As String Set db = CurrentDb For Each tdf In db.TableDefs If Not (tdf.Name Like "MSys*" Or tdf.Name Like "~*" Or tdf.Name Like "exl*") Then sSQL = "ALTER TABLE [" & tdf.Name & "] ALTER COLUMN [id] LONG" db.Execute sSQL Set rs = CurrentDb.OpenRecordset(tdf.Name) If Not rs.BOF And Not rs.EOF Then rs.MoveFirst While (Not rs.EOF) x = x + 1 rs.Edit rs.Fields("id") = x rs.Update rs.MoveNext Wend End If rs.Close Set rs = Nothing End If x = 0 Next MsgBox "تم اعادة الترقيم بنجاح", vbInformation + vbMsgBoxRight, "تأكيد" End Function و في ازرار اعادة الترقيم ضع التالي Call ReNumber 2 رابط هذا التعليق شارك More sharing options...
محمد قاسم 12 قام بنشر سبتمبر 9, 2021 الكاتب مشاركة قام بنشر سبتمبر 9, 2021 هل يمكن تطبيقها على الملف المرفق لو سمحت رابط هذا التعليق شارك More sharing options...
د.كاف يار قام بنشر سبتمبر 9, 2021 مشاركة قام بنشر سبتمبر 9, 2021 (معدل) تفضل التعديل ملاحظة اعادة الترقيم سوف تسبب لك مشكلة كبيرة في الجداول الفرعة لذا يجب عليك عمل نسخة احتياطية قبل البدء و يجب ان تعلم انك ستفقد ارتباط الجداول الأخرى بالجدول الرئيسي لأن مفتاح السجل الرئيسي سيتم تغييره و لن يتعرف على البيانات الخاصة به في الجداول الأخرى تفضل التعديل mr.zip تم تعديل سبتمبر 9, 2021 بواسطه د.كاف يار 2 1 رابط هذا التعليق شارك More sharing options...
محمد قاسم 12 قام بنشر سبتمبر 9, 2021 الكاتب مشاركة قام بنشر سبتمبر 9, 2021 بارك اتلله فيكم والف شكر لكم رابط هذا التعليق شارك More sharing options...
abouelhassan قام بنشر سبتمبر 11, 2021 مشاركة قام بنشر سبتمبر 11, 2021 شكروتقدير واحترام من اخيك استاذى د.كاف يار رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.