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

[تامر خليفه]

مرحبا للجميع

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

وشكرا لحسن التعاون

[co2002co]

DoCmd.SetWarnings False

DoCmd.SetWarnings True

ضع هذا الحدث بعد التحديث

وان شاء الله تتسهل الامور

[king5star]

ستجد ما تريد فى هذه المشاركة

 

 

[تامر خليفه]

عفوا ياشباب اخطأت في صياغه السؤال

سؤالي الاساسي كيف احذف العلاقات بين الجداول برمجيا بشرط بدون اسئله تاكيد

لان حذف الجدول يمكن بالمايكرو لكن بشرط عدم وجود علاقات

اسف مره اخري

وشكرا مجددا

[Shivan Rekany]

 

عفوا ياشباب اخطأت في صياغه السؤال

سؤالي الاساسي كيف احذف العلاقات بين الجداول برمجيا بشرط بدون اسئله تاكيد

لان حذف الجدول يمكن بالمايكرو لكن بشرط عدم وجود علاقات

اسف مره اخري

وشكرا مجددا

الصق هذا في وحدة نمطية

Option Compare Database
Option Explicit

Public Function DeleteAllRelationships()
    Dim db As Database
    Dim rex As Relations
    Dim rel As Relation
    Dim iKt As Integer
    Set db = CurrentDb()
    Set rex = db.Relations
    iKt = rex.Count
    Do While rex.Count > 0
           rex.Delete rex(0).Name
           Loop
MsgBox " تم حذف العلاقاتن بين الجداول بنجاح ", vbInformation, "العلاقات"
End Function

وفي زر حذف العلاقات اكتب
 

Call DeleteAllRelationships

 

[تامر خليفه]

بعد التنفيذ يظهر الخطأ التالي

[Shivan Rekany]

 

بعد التنفيذ يظهر الخطأ التالي

اذا انا ما كان على الخطأ انت دخلت كمستخددم وليس المسؤل
ادخل كمسؤل وجرب

 

[تامر خليفه]

في ٩‏/٢‏/٢٠١٧ at 10:33, Shivan Rekany said:

اذا انا ما كان على الخطأ انت دخلت كمستخددم وليس المسؤل
ادخل كمسؤل وجرب

 

ولكني فعلا ادمن علي الجهاز وهذا يحيرني

اخي الفاضل انا اقوم بالعمل الكثير علي الاكسس والفاجوال ولاول مره يطلب من الدخول كمسئول رغم اني فعلا مسئول 

[رمهان]

اولا احنا يا اخ ثامر راح نحسن الظن ونقول ان الحاجة ليست للخراب والاعطاب

وثانيا الاستاذ شيفان كفى بالكود الموجود

والمشكلة هي انك تحاول حذف علاقة نظام 

وهنا عليك باستثناء هذه العلاقة من الكود او وفي مثال الاستاذ شيفان جرب بكتابة on error resume next  وفي بداية الكود

تحياتي

تم تعديل فبراير 12, 2017 بواسطه رمهان

[تامر خليفه]

13 دقائق مضت, رمهان said:

اولا احنا يا اخ ثامر راح نحسن الظن ونقول ان الحاجة ليست للخراب والاعطاب

اخي الفاضل ولما اقوم بخراب ما اقوم به 

ولو كان المطلوب ان اخرب عمل شخص اخر عياذا بالله ما كنت احتاج الي ان احذف كامل البرنامج

وثانيا الاستاذ شيفان كفى بالكود الموجود

عفوا لا افهم المقصود بالجمله

والمشكلة هي انك تحاول حذف علاقة نظام 

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

وهنا عليك باستثناء هذه العلاقة من الكود او وفي مثال الاستاذ شيفان جرب بكتابة on error resume next  وفي بداية الكود

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

تحياتي

تقبل كل التحايا

 

تم تعديل فبراير 12, 2017 بواسطه تامر خليفه

[أبو عبدالله الحلوانى]

السلام عليكم 

اسمحو لى بتوضيح بسيط: من المعروف أن الأكسس يحتوى على جداول يحتفظ بها لنفسه تسمى جداول النظام وهذه الجداول لا يمكن للمستخدم التحكم بها بل يتحكم بها الأكسس بشكل آلى تماما وهذه الجداول أى خلل بها يؤدى لتلف قاعدة البيانات - وهذه الجداول يبدأ أسم كل جدول بها بالبادئة "MSys" 

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

والأخرى: وضع هذه العبارة   on error resume next  بالكود لن يستثنى أو يثبت شىء وانما هذه الجملة لتجاوز الخطأ عند حدوثه وعدم اظهار مثل رسائل الخطأ السابقة 

وفى النهاية جرب كود أخينا شيفان بهذا التعديل

Option Compare Database
Option Explicit

Public Function DeleteAllRelationships()
On error goto erDletRl
    Dim db As Database
    Dim rex As Relations
    Dim rel As Relation
    Dim iKt As Integer
    Set db = CurrentDb()
    Set rex = db.Relations
    iKt = rex.Count
    Do While rex.Count > 0
       rex.Delete rex(0).Name
    Loop

Exit Function

erDletRl:
if Err.Number = 0 then
MsgBox " تم حذف العلاقات بين الجداول بنجاح ", vbInformation, "العلاقات"
elseif Err.Number = 3033 then 
Resume Next
else
msgbox Err.Number & VbCr & Err.Descrption
End if

End Function

وفي زر حذف العلاقات اكتب


Call DeleteAllRelationships

تمنياتى بالتوفيق

تم تعديل فبراير 12, 2017 بواسطه أبو عبدالله الحلوانى

[رمهان]

ايش رايك تنسى موضوع العلاقات

انتبه جرب على قاعدة للتجربة !!

Do While DCount("*", "msysobjects", "Left([name],1)<>'~' and Left([name],4)<>'MSys' and Type in(1,4,6) and lvprop is not null") > 0
Set rst = CurrentDb.OpenRecordset("SELECT MSysObjects.Name FROM MSysObjects WHERE (((Left([Name],1))<>'~') AND ((Left([Name],4))<>'MSys') AND ((MSysObjects.Type) In (1,4,6))) and lvprop is not null order by MSysObjects.Name"): rst.MoveFirst
Do While Not rst.EOF
On Error GoTo 10:
CurrentDb.TableDefs.Delete rst(0)
10: rst.MoveNext
Loop
Loop
Application.RefreshDatabaseWindow
MsgBox ("done")

تحياتي