[ تمت الإجابة ]مشكلة الترقيم التلقائي

أبو ليمونه

ما هي مشكلتك مع الترقيم لأن في المنتدى مشاركات كثيرة تستخدم عدة طرق للترقيم التلقائي

هل بحث عن ذكل ؟

اخي مصلح

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

ولك مني جزيل الشكر

بعد اذن مشرفنا الفاضل ابو ساره

اخي الفاضل

هل قرأت جيدا التعليمات الخاصة بهذه الدالة

تقول لك التعليمات التالي :

1. قم بعمل نسخة احتياطية من قاعدة بياناتك

2. في نافذة قاعدة البيانات ( الخاصة بأكسيس 2007 ) اختر تبويب الوحدات النمطية Modules

3. قم بإنشاء وحدة نمطية جديده

4. انسخ والصق هذه الوظيفة Function الى الوحدة النمطية الجديده

Function AutoNumFix() As Long
	'Purpose:   Find and optionally fix tables in current project where
	'			   Autonumber is negative or below actual values.
	'Return:	Number of tables where seed was reset.
	'Reply to dialog: Yes = change table. No = skip table. Cancel = quit searching.
	'Note:	Requires reference to Microsoft ADO Ext. library.
	Dim cat As New ADOX.Catalog 'Catalog of current project.
	Dim tbl As ADOX.Table	   'Each table.
	Dim col As ADOX.Column	  'Each field
	Dim varMaxID As Variant	 'Highest existing field value.
	Dim lngOldSeed As Long	  'Seed found.
	Dim lngNewSeed As Long	  'Seed after change.
	Dim strTable As String	  'Name of table.
	Dim strMsg As String		'MsgBox message.
	Dim lngAnswer As Long	   'Response to MsgBox.
	Dim lngKt As Long		   'Count of changes.

	Set cat.ActiveConnection = CurrentProject.Connection
	'Loop through all tables.
	For Each tbl In cat.Tables
		lngAnswer = 0&
		If tbl.Type = "TABLE" Then  'Not views.
			strTable = tbl.Name	 'Not system/temp tables.
			If Left(strTable, 4) <> "Msys" And Left(strTable, 1) <> "~" Then
				'Find the AutoNumber column.
				For Each col In tbl.Columns
					If col.Properties("Autoincrement") Then
						If col.Type = adInteger Then
							'Is seed negative or below existing values?
							lngOldSeed = col.Properties("Seed")
							varMaxID = DMax("[" & col.Name & "]", "[" & strTable & "]")
							If lngOldSeed < 0& Or lngOldSeed <= varMaxID Then
								'Offer the next available value above 0.
								lngNewSeed = Nz(varMaxID, 0) + 1&
								If lngNewSeed < 1& Then
									lngNewSeed = 1&
								End If
								'Get confirmation before changing this table.
								strMsg = "Table:" & vbTab & strTable & vbCrLf & _
									"Field:" & vbTab & col.Name & vbCrLf & _
									"Max:  " & vbTab & varMaxID & vbCrLf & _
									"Seed: " & vbTab & col.Properties("Seed") & _
									vbCrLf & vbCrLf & "Reset seed to " & lngNewSeed & "?"
								lngAnswer = MsgBox(strMsg, vbYesNoCancel + vbQuestion, _
									"Alter the AutoNumber for this table?")
								If lngAnswer = vbYes Then   'Set the value.
									col.Properties("Seed") = lngNewSeed
									lngKt = lngKt + 1&
									'Write a trail in the Immediate Window.
									Debug.Print strTable, col.Name, lngOldSeed, " => " & lngNewSeed
								End If
							End If
						End If
						Exit For 'Table can have only one AutoNumber.
					End If
				Next	'Next column
			End If
		End If
		'If the user chose Cancel, no more tables.
		If lngAnswer = vbCancel Then
			Exit For
		End If
	Next	'Next table.

	'Clean up
	Set col = Nothing
	Set tbl = Nothing
	Set cat = Nothing
	AutoNumFix = lngKt
End Function

5. اختر المراجع والمكتبات References من خلال محرر الفيجول بيسك الذي وضعت فيه الوظيفة الجديده من خلال قائمة ادوات Tools menu ثم اختر References ثم ضع علامة صح على المكتبة Microsoft ADO Ext. 2.x for DDL and Security ( طبعا يتم البحث عنها من بين المكتبات ثم نضع عليها علامة صح )

6. من خلال قوائم الأكسيس نختار قائمة البحث عن الخطاء Debug menu ثم نختار Compile لغرض معرفة هل هناك خطأ في الكود ام لا لكي نقوم بتصحيحه

7. وانت في نفس نافذة محرر الفيجول بيسك الذي وضعت فيه كود الوظيفة اضغط على المفتاحين معا Ctrl+G من لوحة المفاتيح لتظهر لك نافذة سفلية خاصة بتجربة الدالة حيث نضع بها هذا الأمر

? AutoNumFix()

سيقوم الكود مباشرة بالمرور على كافة الجدالو الموجوده لديك في القاعدة ومن ثم يقوم بإختيار حقول الترقيم التلقائي AutoNumber والمفهرسة ويقوم بإصلاحها بدون ان تشعر بذلك لأن ذلك يتم في الخلفية عن طريق محرك قاعدة البيانات Version 4 of JET

وهذه هي القاعدة على اكسيس 2003 تم انشاء الوحدة النمطية بها ووضع الوظيفة Function AutoNumFix بها .

AutoNumFix.rar

ملاحظة : تذكر انه يقول لك انها تعمل مع اكسيس 2007

السلام عليكم

شكرالك اخت زهرة لتفاعلك مع الموضوع

للاسف حاولت استخدام الملف المرفق وقمت بانشاء جدول فيه خانة ترتيب تلقائي لكن لم يرتبها الترتيب الصحيح

واذا ضغطت على المايكرو يعطيني رسالة ارور

الملف مرفق

تحياتي لك

AutoNumFix.zip

سامحك الله اخي الكريم

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

لماذا لا تقول من البداية انك تريد اعادة الترقيم التلقائي الى وضعه الطبيعي ؟؟؟؟

حسنا لا يوجد مشكله

قمنا بحذف الوظيفة السابقة فأنت لا تحتاج اليها وليست هي المطلوبه لإعادة الترقيم التلقائي

الآن قم بفتح الجدول الخاص بك وتاكد جيدا ان الترقيم التلقائي مخربط اي غير مرتب بالترتيب الصحيح

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

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

ولا تنسى تعطينا خبر بارك الله بك

za_AutoNumFix_UP.rar

السلام عليكم

اختي زهرة والله انا فشلان منك ... لاني ظننت الكود هو لاعادة الترقيم التلقائي وليس اصلاحه

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

ويعمل بكفائة

هل استطيع ان اضيف الكود الذي وضعتيه وهو

On Error Resume Next
Dim strSQL1, strSQL2 As String
strSQL1 = "ALTER TABLE [Table1] DROP COLUMN [id];"
strSQL2 = "ALTER TABLE [Table1] ADD [ID]AUTOINCREMENT;"
DoCmd.RunSQL strSQL1
DoCmd.RunSQL strSQL2

في الحدث عند فتح تقرير معين؟

ولك مني كل الشكر والتقدير

جزيل الشكر للأخت زهرة على ما تقدمه من مساعدات

ولكن الكود المرفق عند تنفيذ الأمر يقوم فقط بإصلاح الترقيم إذا كان هناك بيانات في الجدول

ولكنه لا يعمل إذا كان الجدول فارغاً

وحتى يكون المثال كاملاً

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

فعلى سبيل المثال عند تصميم قاعدة جديدة وبعد التجربة عليها عدة مرات، يكون الترقيم التلقائي غير مرتب في جميع الجداول التي تم التجربة عليها، لذا المطلوب هو تصحح الترقيم التلقائي وإعادته من الرقم 1 إن أمكن.

السلام عليكم

اختنا زهرة المنتدي حلولك دائما رائعة مثلك

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

لان فى هذه الحالات لن يعمل الكود --- وهذا منطقي لان الحقل Autonumber لا يفترض ان يكون مفهرس او مفتاح اساسي

بارك الله فيكي اختنا زهرة

أبو ليمونه كتب:

السلام عليكم

اختي زهرة والله انا فشلان منك ... لاني ظننت الكود هو لاعادة الترقيم التلقائي وليس اصلاحه

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

ويعمل بكفائة

هل استطيع ان اضيف الكود الذي وضعتيه وهو

On Error Resume Next
Dim strSQL1, strSQL2 As String
strSQL1 = "ALTER TABLE [Table1] DROP COLUMN [id];"
strSQL2 = "ALTER TABLE [Table1] ADD [ID]AUTOINCREMENT;"
DoCmd.RunSQL strSQL1
DoCmd.RunSQL strSQL2

في الحدث عند فتح تقرير معين؟

ولك مني كل الشكر والتقدير

اخي الفاضل ابو ليمونه

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

ولكن نحتاج هذا الشرح التفصيلي المصور لعمل الترقيم التلقائي في التقرير

/index.php?showtopic=102516

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

تحياتي لك

بسم الله الرحمن الرحيم

تمت الإجابة على الموضوع

إدارة الفريق العربي للبرمجة