نجوم المشاركات

السلام عليكم ورحمة الله وبركاته في هذا الإصدار يوجد ثلاث تطبيقات ( الملف بالمرفقات ) - awsReg_Colorize_VBE لتلوين محرر الأكواد - awsReg_HyperLink_Warning لتفعيل وتعطيل [ application.FollowHyperlink warning ] تم شرح وإضافة الأكواد بالمشاركة التالية بالموضوع الأول الرابط من هنا - awsReg_User_Trusted_Helper_MOD للتحكم بالمواقع الموثوقة Trusted Locations التطبيق الأول : تلوين محرر الأكواد يوجد بعض الأدوات المجانية التي تتيح التعديل علي ألوان محرر الأكواد وتعتمد فكرتها علي التعديل في ملف الـ VBA{Ver}.dll مثال : https://github.com/gallaux/VBEThemeColorEditor ولكن يمكن تحقق نفس النتيجة يدوي او من خلال إضافة قيم للريجيستري يدوي : عن طريق الأكواد إضافة القيم التالية للريجيستري في المسار (HKEY_CURRENT_USER\Software\Microsoft\VBA\7.1\Common) 7.1 هو رقم الاصدار وقد يختلف وتم إضافة المسارات المتوقعة بالاكواد CodeForeColors | CodeBackColors | FontFace | FontHeight | FontCharSet طريقة الإستخدام :call setUpVbeColors(awsDark3) ملحوظة : عند اختيار الخط يفضل اختار ما يدعم اللغة العربية إذا كنت تريد إضافة تعليقات باللغة العربية كما يجب التاكد من الأحجام المتاحة فبعض الخطوط تتيح أحجام محددة مثال بانتظار مشاركة إبداعتكم التطبيق الثالث : إضافة مسار البرامج الخاصة بك في المواقع الموثوقة Trusted Locations لماذا يفضل إضافة المسار الخاص ببرنامجك إلي المواقع الموثوقة ؟ 1- الحد من ظهور التحذيرات أثناء عمل البرنامج وعند كل تشغيل 2- والأهم هي سرعة عمل الأكود فوفق دراسة قام بها بعض المبرمجين فإن الأكود تعمل بشكل أسعر يصل إلي 23× رابط المصدر من هنا اقتباس من المصدر : هل يوجد مكان واحد للإضافة ؟ لا يوجد أكثر من مكان للضافة ولكل مكان ميزاته وعيوبة مثال : فالمسار الخاص بإضافة المواقع الموثوقة لكل برنامج من برامج الاوفيس هو Software\Microsoft\Office\16.0\Access\Security\Trusted Locations ويتغير اسم البرنامج ورقم الإصدار وفق النسخة والبرنامج المستهدف فإذا كان الجذر (ROOT ) هو [ HKEY_CURRENT_USER ] فمن يتأثر بهذه المواقع هو اليوزر الحالي فقط ولكن إن كان [ HKEY_LOCAL_MACHINE] فيتأثر جميع المستخدمين كما ان هناك ترتيب فالموقع داخل HKEY_CURRENT_USER له الأفضلية علي HKEY_CURRENT_USER الموقع الموثوق عبارة عن مفتاح وهو اسم الموقع ويوجد بداخل قيم ويوجد تحت المفتاح الرئيس [Trusted Locations] قيم مثال [USER Trusted Locations Values] : HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Access\Security\Trusted Locations --------------------------------------------- [Value Name ] : AllLocationsDisabled [Value Data ] : False [Value Type ] : REG_DWORD [Value Integer] : 0 [Note ] : All Trusted Locations are Allowed --------------------------------------------- [Value Name ] : AllowNetworkLocations [Value Data ] : False [Value Type ] : REG_DWORD [Value Integer] : 0 [Note ] : All NetWork Locations are Disabled --------------------------------------------- [Locations] : HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Access\Security\Trusted Locations\awsTLocation --------------------------------------------- [Location Name ] : awsTLocation [Location Number] : 02 [Location Values] : [Value Name ] : Path [Value Data ] : D:\AWSTRUSTLOCATION3\ [Value Type ] : REG_SZ ----------------------------------- [Value Name ] : Description [Value Data ] : This Location Has Been Trusted By : AWS REG [Value Type ] : REG_SZ ----------------------------------- [Value Name ] : Date [Value Data ] : 17/11/2024/ 10:41:00 AM [Value Type ] : REG_SZ ----------------------------------- [Value Name ] : AllowSubfolders [Value Data ] : True [Value Type ] : REG_DWORD [Value Integer] : 1 [Note ] : All Sub Folders are Allowed ----------------------------------- --------------------------------------------- فإذا تم تفعيل القيمة [AllLocationsDisabled] تحت المفتاح [Trusted Locations] فهذا يعني تعطيل جميع المسارات الموثوقة تحذير هام: أنصح بعدم وضع المسارات شائعة الاستخدم كسطح المكتب والتنزيلات حتي لا نضعف حماية النظام ملحوظة: أكبر عدد مسموح به للإضافة هو 20 لكل برنامج أوفيس الأمثلة موجودة في مديول : awsReg_Trusted_Locations كما يوجد شرح أيضاً في راس المديول : awsReg_User_Trusted_Helper_MOD تم إضافة تعديل علي الكلاس مديول بإضافة دالة جديدة : allValuesKeysDictColl ------------------------------------------------------------------------------------------- أود الإشارة إلي هذه المقاطع داخل الأكواد لأهميتها 1- داخل الكود loadUserTrusted في هذا الجزء يتم إضافة المسارات الموجودة إلي قاموس ليتم التحقق منها لاحقاً وعلية قد يكون هناك مسار مكرر داخل مفاتيح باسماء مختلفة ولذلك أقوم بحذف الموقع الموثق صاحب المسار المكرر هكذا عالجت الأمر وفق تصوري 2- داخل الكود setUserAppTrustLocation تم تعليق هذا الجزء من الكود لعدم إحتياجي له ويمكنك تفعيله إذا كنت ترد ظهور رسالة في حال تم إيجاد اسم الموقع فإذا اجبت بنعم سيتم تغير المسار داخل الموقع الموجود وإذا أجبت بلا سيتم إضافة _1 لإسم الموقع وإضافة موقع جديد ------------------------------------------------------------------------------------------- يسعدني الإجابة علي استفسارتكم الأكواد متاح للجميع للتعديل والإضافات بالتوفيق winRegApi_OV2.zip

جرب هدا Dim OnRng(), tbl, Irow, ColVisu(), Dates(), Choix() Private Sub UserForm_Initialize() tbl = "Table2" OnRng = Range(tbl).value For i = 1 To UBound(OnRng): OnRng(i, 2) = CDate(OnRng(i, 2)): Next i Irow = Range(tbl).Columns.Count ColVisu = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12) ListBox1.ColumnCount = 12 Set d = CreateObject("scripting.dictionary") d("*") = "" For i = LBound(OnRng) To UBound(OnRng) d(OnRng(i, 3)) = "" Next i Choix = d.keys '================' رقم السيارة ============== Tri Choix, LBound(Choix), UBound(Choix) Dim iTemp As Variant For i = LBound(Choix) To (UBound(Choix) - LBound(Choix)) \ 2 iTemp = Choix(i) Choix(i) = Choix(UBound(Choix) - i) Choix(UBound(Choix) - i) = iTemp Next i Me.ComboBox1.List = Choix '================' اسم السائق ======================== Set d = CreateObject("scripting.dictionary") d("*") = "" For i = LBound(OnRng) To UBound(OnRng) d(OnRng(i, 4)) = "" Next i Choix = d.keys Tri Choix, LBound(Choix), UBound(Choix) Me.ComboBox4.List = Choix Set d = CreateObject("scripting.dictionary") colDate = 2 For i = LBound(OnRng) To UBound(OnRng) d(OnRng(i, colDate)) = "" Next i Dates = d.keys Tri Dates, LBound(Dates), UBound(Dates) Me.ComboBox2.List = Dates: Me.ComboBox2 = Dates(0) Me.ComboBox3.List = Dates: Me.ComboBox3 = Dates(UBound(Dates)) Filtre End Sub Sub Filtre() Dim tbl() clé = Me.ComboBox1: If clé = "" Then clé = "*" cléLieu = Me.ComboBox4: If cléLieu = "" Then cléLieu = "*" début = CDate(Me.ComboBox2) fin = CDate(Me.ComboBox3) colDate = 2 n = 0 For i = LBound(OnRng) To UBound(OnRng) If OnRng(i, colDate) >= début And OnRng(i, colDate) <= fin And OnRng(i, 3) Like clé And OnRng(i, 4) Like cléLieu Then n = n + 1: ReDim Preserve tbl(1 To Irow, 1 To n) c = 0 For Each K In ColVisu c = c + 1: tbl(c, n) = OnRng(i, K) Next K End If Next i If n > 0 Then Me.ListBox1.Column = tbl Else Me.ListBox1.Clear MsgBox "لم يتم العثور على بيانات مطابقة", vbInformation, "نتائج التصفية" End If End Sub ListBox1.ColumnCount = 12-V2.xlsm

السلام علبكم 🙂 بسبب اختلاف تنسيقات ملفات الاكسل (او CSV) ، وخصوصا تلك التي من مواقع وزارة التعليم في المملكة العربية السعودية ، كنا نضطر ان نتعامل بالكود مع كل تنسيق بطريقة تختلف عن الملف الآخر ، مما يجعل الحل لا يتناسب مع التنسيقات الملفات الاخرى ، وهذا الكود ليس بالسهل تعديله. ولكن ، تقريبا جميع مستخدمي الاكسس يعرفون التعامل مع الاستعلام ، لهذا السبب دعونا نتعامل مع بيانات الاكسل في استعلام ، استعلام مسقط 🙂 هذه واجهة النموذج الذي يتم كل شيء عن طريقه: 1. لتصفح الملفات ، واختيار ملف الاكسل (xls, xlsx, xlsm, csv) ، وسيظهر اسم الملف الذي تم اختيارة في الحقل رقم 2 ، 3. ستظهر قائمة بأسماء الاوراق (Sheets) الموجودة في الملف ، ويجب اختيار الورقة المطلوبة ، 4. هذا نموذج جدولي ، و ستظهر بيانات ورقة الاكسل هنا ، ويمكننا التعامل مع فرز وتصفية البيانات هنا ، وبعدة طرق ، 5. سيظهر استعلام مناداة ورقة الاكسل هنا (بدون فرز وتصفية) ، على شكل SQL ، وبأسماء حقول الورقة ، والتي يمكن نسخها لأي قاعدة بيانات خارجية ، 6. سيظهر استعلام مناداة ورقة الاكسل هنا (بدون فرز وتصفية) ، على شكل SQL ، وبدون أسماء حقول الورقة ، والتي يمكن نسخها لأي قاعدة بيانات خارجية ، 7. يجب النقر هنا حتى نرى نتائج الفرز والتصفية كجزء من الاستعلام في الحقول 8 و 9 ، 8. سيظهر استعلام مناداة ورقة الاكسل هنا (بالفرز والتصفية) ، على شكل SQL ، وبأسماء حقول الورقة ، والتي يمكن نسخها لأي قاعدة بيانات خارجية ، 9. سيظهر استعلام مناداة ورقة الاكسل هنا (بالفرز والتصفية) ، على شكل SQL ، وبأسماء حقول الورقة ، والتي يمكن نسخها لأي قاعدة بيانات خارجية ، 10. يمكنك عمل استعلام جاهز (للورقة بدون فرز وتصفية) او جدول ، سواء في قاعدة البيانات هذه ، او اختيار قاعدة بيانات خارجية (يجب ان تكون مغلقة حتى تستطيع تصدير استعلام او جدول لها) ، وسيكون اسم الاستعلام نفس اسم الورقة ، مثلا اسم الورقة ABC ، فيصبح اسم الاستعلام: qry_ABC ، او يكون جدول بإسم tbl_ABC حسب اختيارك من الرقم 11 ، او حتى الحاق بيانات الاستعلام الى جدول موجود سابقا (طبعا يجب مراعاة ان يكون الجدول بنفس حقول الورقة) ، 12. لنسخ الاستعلام الى ذاكرة الكمبيوتر ، بحيث يمكنك استعمال لصق ctrl+v لكائن الاستعلام (انظ الفيديو التوضيحي) ، 13. عادة لا نغير اي شيء هنا. طريقة العمل: . نرى من اعلاه: 1. انه تم عمل استعلام ياسم qry_Sheet1 في قاعدة البيانات الخارجة Testing.accdb ، 2. كذلك نسخنا استعلام التصفة الى ذاكرة الكمبيوتر (تابع في الفيديو التالي) . ممكن خلط عمل الفرز و التصفية بعدة طرق ، منها كما في الفيديو اعلاه ، و الصور التاليه . . لنفتح قاعدة البيانات الخارجية ونرى ما فيها ، هنا نحن نتعامل مع استعلام اكسس عادي ، فيمكننا حذف الحقول التي لا نريدها ، او نخفي اخرى ، او .... . عند فتح قاعدة البيانات الخارجية ، وحصلت على رسالة الخطأ هذه ، فهذا معناه ان برنامج "استعلام مسقط" لايزال مفتوح ، وملف الاكسل مفتوح به ، لذا يجب اغلاق برنامج "استعلام مسقط" قبل استعمال ملف الاكسل : . البرنامج يتعامل مع ملف واحد فقط ، ويعمل له استعلام ، واذا اردنا ان نتعامل مع اكثر من ورقة اكسل ، فيمكننا عمل مجموعة من استعلامات ، ثم نعمل امر لتنفيذها واحدة تلو الاخرى ، وبما انه عندنا استعلام ، فيمكننا تحويله الى جميع انواع الاستعلامات ، سواء استعلام الحاق ، او استعلام اضافة ، او استعلام لعمل جدول. هناك عدة ميزات في استعمال هذه الطريقة عن ربط الاكسل كجدول : 1. اسرع بكثير ، 2. عند استيراد كائنات قاعدة البيانات الى قاعدة اخرى ، فالاكسس يتوقف كثيرا عند الجداول الاكسل المرتبطة ، بينما لا يأخذ اي وقت لهذا الاستعلام 3. اختار الحقول اللي تريدها فقط ، جعفر Muscat_Query.zip

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

فورم اكسل لحساب المصاريف بالذكاء الاصطناعى موقع sider صورة من الموقع للاكواد فورم لحساب المصاريف المدرسية.xlsm

يمكنك دمج الطريقتين مع بعض كما في الصورة ListBox1.ColumnCount = 12-V3.xlsm

وعليكم السلام ورحمة الله وبركاته كود ترحيل التغيير من الوصل الى السجل.xlsm

جملتك هذه فهمت منها من كلمة نفس الحقول اي اتركها كما هي نتائج المقارنة.xlsb نتائج المقارنة1.xlsb

بارك الله فيك وفى صحتك وعافيتك كلام جميل جدا وسحر فى الاكواد ـ الله يبارك لك فى علمك وفى اسرتك ـ امين صاحبى / فادى هل تقصد بان status هى no انها غير نشطة يعنى اتاكد اولا ان علامة الصح غير موجودة عليها ام العكس وانا اريد ان تلغى الرسالة التى تقول : "تم عملية فك التشفير بنجاح " والرسالة التى تقول "تم علمية التشفير بنجاح" انا قمت بالغاء الرسالة ولكن اريد ان يختصر الكود بقدر الامكان وسؤال تانى ارى انه سؤال ليس وقته وهو : هل ممكن نجعل التشفير للحقول الرقمية ايضا وليس للحقول النصية فقط لو كان بايدى لجعلتك ليس خبيرا فقط وليس من فريق المنتدى ولكن يتوج اسمك بعنوان كبير فى المنتدى ـ مع احترامى لكل فريق الموقع وخبراء المنتدى ـ ان كان تخيلى فى مكانه ولا انسى فضل ومساعدة سيخنا الجليل / ابو خليل فهو صاحب الفكرة واول من قام بمساعدتى زادك الله صحة وعافيه ـ واطال الله عمرك معلمنا الجليل جزاك الله كل خير

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

نعم صح وازيدك من الشعر بيت "فيما لو فرضنا ضبط المسألة بطريقة ما" .. لما يكون احد المستخدمين فاتح البرنامج .. يكون المجال مفتوح لنسخ الجداول على الاجهزة الأخرى وتصديرها من غير فتح البرنامج

ما شاء الله تبارك الرحمن .. 😊🌼 سباق محتدم في الإبداعات والابتكارات هذه الفترة .. شكله موسم الإبداعات 😁👌 سلمت يمناك عم الحاج مستر @Foksh .. شغل معلمين 👍🙂 .. لكن سؤالي هو : هل هذه الحركة سوف تتوافق مع قواعد البيانات المشتركة لأكثر من مستخدم ؟ ألن يحصل تضارب بين المستخدمين عند التشفير وفكه وخصوصا وقت إدخال البيانات ؟ فرص حصول الأخطاء كبيرة .. وخصوصا لو نسينا تغيير حالة ال status قبل عملية إدخال البيانات .. هي مجرد أفكار ولعلها من وحي الخيال وضرب من ضروب الفكر فقط 🙂🖐

جميل جدا .. مع ان الحقل status ثغرة يمكن التلاعب بها فتنعكس العملية . هل الاعلان عن متغير رقمي عند الفتح وعندما يتم فك التشفير تتغير قيمته من اجل شرط التشفير يقوم بالمهمة بدلا من الحقل ؟ والافضل عند تغير قيمة المتغير ان تتغير الى : صفر ويكون هو الشرط لماذا ؟ ... خشية ان يحدث خطأ .. فاي error عند العمل على البرنامج مهما كان صغيرا يسبب مسح للذاكرة هنا لو تم مسح الذاكرة سيبقى المتغير على قيمته الافتراضية صفر

السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء ) قمت بتنفيذ فكرة تعقب التغييرات بين الجداول والمبنية على فكرة الأستاذ @ابو البشر ( مشكوراً ) مع إجراء بعض التعديلات ، بحيث تم منح المستخدم الحرية في اختيار جدولين ومفتاح ربط أساسي و مشترك فيما بينهم بشكل بسيط وسهل ، ولا يحتاج الأمر لأي مكتبات أو دعم خارجي . ⭐ ما احتجنا له هو كومبوبوكس عدد 3 ، وزر واحد فقط وظائفهم كالآتي :- cmbTable1 : التعرف على أسماء الجداول في قاعدة البيانات ، وهنا سيكون الجدول الأول . cmbTable2 : التعرف على أسماء الجداول في قاعدة البيانات باستثناء الجدول الذي تم اختياره في cmbTable1 ؛ والهدف هو عمل مقارنة بين جدولين وليس نفس الجدول . cmbPrimaryField : التعرف على أسماء الحقول في الجدول الأول ، ثم يتم اختيار الحقل المشترك أو المفتاح الأساسي من طرف المستخدم . btnExecute : منفّـذ العملية . ⭐ الأحداث والأكواد لكل جزء و عنصر في البرنامج :- في حدث عند التحميل للنموذج ، تم وضع الكود التالي لجلب أسماء الجداول إلى الكومبوبوكس ( cmbTable1 و cmbTable2 ) ، وطبعاً سيتم استثناء جداول النظام والجدول DifferencesTable الذي سيتم إدراج التغييرات فيه ( والذي سيتم انشائه بشكل ديناميكي في قاعدة البيانات عند المستخدم عند عدم وجوده ) . أي أنه وللإستفادة من البرنامج ما عليك إلا نسخ النموذج فقط الى مشروعك . Private Sub Form_Load() Me.cmbTable2.Enabled = False Me.cmbPrimaryField.Enabled = False Dim tdf As DAO.TableDef Me.cmbTable1.RowSource = "" Me.cmbTable2.RowSource = "" For Each tdf In CurrentDb.TableDefs If Left(tdf.Name, 4) <> "MSys" And tdf.Name <> "DifferencesTable" Then Me.cmbTable1.AddItem tdf.Name 'Me.cmbTable2.AddItem tdf.Name End If Next tdf End Sub في حدث بعد التحديث للكومبوبوكس cmbTable1 ، سيتم إدراج أسماء الجداول المتبقية كما ذكرت سابقاً في الكومبوبوكس cmbTable2 باستثناء ما تم اختياره في الجدول cmbTable1 :- Private Sub cmbTable1_AfterUpdate() Dim db As DAO.Database Dim tdf As DAO.TableDef Dim fld As DAO.Field Me.cmbPrimaryField.RowSource = "" Set db = CurrentDb Set tdf = db.TableDefs(Me.cmbTable1.Value) For Each fld In tdf.Fields Me.cmbPrimaryField.AddItem fld.Name Next fld Me.cmbTable2.RowSource = "" For Each tdf In db.TableDefs If Left(tdf.Name, 4) <> "MSys" And tdf.Name <> "DifferencesTable" And tdf.Name <> Me.cmbTable1.Value Then Me.cmbTable2.AddItem tdf.Name End If Next tdf Me.cmbTable2.Enabled = True Set fld = Nothing Set tdf = Nothing Set db = Nothing End Sub في حدث عند النقر على الزر btnExecute ، سيتم تنفيذ الكود التالي :- Private Sub btnExecute_Click() Dim db As DAO.Database Dim rsOld As DAO.Recordset Dim rsNew As DAO.Recordset Dim rsDifferences As DAO.Recordset Dim fld As DAO.Field Dim recordFound As Boolean Dim commonFields As Collection Dim fieldName As Variant Dim primaryField As String Dim table1 As String Dim table2 As String If IsNull(Me.cmbTable1) Then MsgBox "قم باختيار الجدول الأول", vbCritical, "" Me.cmbTable1.SetFocus Exit Sub ElseIf IsNull(Me.cmbTable2) Then MsgBox "قم باختيار الجدول الثاني", vbCritical, "" Me.cmbTable2.SetFocus Exit Sub ElseIf IsNull(Me.cmbPrimaryField) Then MsgBox "قم باختيار الحقل الأساسي", vbCritical, "" Me.cmbPrimaryField.SetFocus Exit Sub Else table1 = Me.cmbTable1.Value table2 = Me.cmbTable2.Value primaryField = Me.cmbPrimaryField.Value If IsNull(table1) Or IsNull(table2) Or IsNull(primaryField) Then MsgBox "Please select both tables and the primary field." Exit Sub End If Set db = CurrentDb If Not TableExists("DifferencesTable") Then CreateDifferencesTable db End If Set rsOld = db.OpenRecordset(table1) Set rsNew = db.OpenRecordset(table2) Set rsDifferences = db.OpenRecordset("DifferencesTable", dbOpenDynaset) DoCmd.SetWarnings False DoCmd.RunSQL "DELETE FROM DifferencesTable;" DoCmd.SetWarnings True Set commonFields = New Collection For Each fld In rsOld.Fields On Error Resume Next If Not IsNull(rsNew.Fields(fld.Name).Name) Then If fld.Name <> primaryField Then commonFields.Add fld.Name, fld.Name End If End If On Error GoTo 0 Next fld Do While Not rsOld.EOF recordFound = False rsNew.MoveFirst Do While Not rsNew.EOF If rsOld(primaryField) = rsNew(primaryField) Then recordFound = True For Each fieldName In commonFields If Nz(rsOld(fieldName), "") <> Nz(rsNew(fieldName), "") Then rsDifferences.AddNew rsDifferences("ID") = rsOld(primaryField) rsDifferences("ChangeType") = "Modification" rsDifferences("FieldName") = fieldName rsDifferences("OldValue") = rsOld(fieldName) rsDifferences("NewValue") = rsNew(fieldName) rsDifferences.Update End If Next fieldName Exit Do End If rsNew.MoveNext Loop If Not recordFound Then rsDifferences.AddNew rsDifferences("ID") = rsOld(primaryField) rsDifferences("ChangeType") = "Deletion" rsDifferences("FieldName") = "عمليات الحذف أو الإضافة" rsDifferences("OldValue") = "عملية حذف" rsDifferences("NewValue") = Null rsDifferences.Update End If rsOld.MoveNext Loop rsNew.MoveFirst Do While Not rsNew.EOF recordFound = False rsOld.MoveFirst Do While Not rsOld.EOF If rsNew(primaryField) = rsOld(primaryField) Then recordFound = True Exit Do End If rsOld.MoveNext Loop If Not recordFound Then rsDifferences.AddNew rsDifferences("ID") = rsNew(primaryField) rsDifferences("ChangeType") = "Addition" rsDifferences("FieldName") = "عمليات الحذف أو الإضافة" rsDifferences("OldValue") = Null rsDifferences("NewValue") = "عملية إضافة" rsDifferences.Update End If rsNew.MoveNext Loop rsOld.Close rsNew.Close rsDifferences.Close Set rsOld = Nothing Set rsNew = Nothing Set rsDifferences = Nothing Set db = Nothing End If CreatePivotQuery table1, table2 MsgBox "تمت عملية المقارنة في الجدولين ، وسيتم فتح الاستعلام بالنتائج", vbInformation, "" DoCmd.OpenQuery "Foksh", acViewNormal End Sub الكود يقوم بتنفيذ عملية مقارنة بين بيانات الجدولين ( من خلال اختيار الجدول الأول والجدول الثاني كما ذكرت سابقاً ) في أي قاعدة بيانات للمستخدم . وفيما يلي شرح مبسط للخطوات الرئيسية التي ينفذها هذا الكود ( للفائدة ):- التحقق من القيم في الكومبوبوكسات الثلاثة يتم التحقق مما إذا كان المستخدم قد اختار الجداول الأساسية ( الجدول الأول و الجدول الثاني ) وحقل المفتاح الأساسي للمقارنة . فإذا كانت أي من هذه المدخلات مفقودة أو لم يتم اختياره ، يعرض الكود رسالة تحذير بوجوب اختيار الجدول أو المفتاح الأساسي وبالتالي يوقف العملية . تحضير البيانات يتم فتح السجلات من الجداول المختارة (الجدول الأول والجدول الثاني) وإنشاء سجل جديد في جدول DifferencesTable لتخزين الفروقات والتغيرات . مقارنة البيانات سيقوم الكود بمقارنة السجلات في الجدولين اللذين تم اختيارهم سابقاً . فإذا كانت السجلات متطابقة في كلا الجدولين ، يتم مقارنة الحقول المشتركة فقط - أي الحقول الموجودة و المتشابهة بالإسم في الجدولين (باستثناء الحقل الأساسي) لتحديد التغييرات . فإذا كانت السجلات مفقودة في أحد الجدولين ( أي تم الحذف أو الإضافة في أي من الجدولين ) ، يتم تحديد نوع التغيير كـ ( عملية حذف ) أو ( عملية إضافة ). إدخال النتائج وإضافتها للجدول DifferencesTable يتم إضافة البيانات الناتجة عن التغييرات ( مثل القيمة القديمة والجديدة ) في جدول DifferencesTable ، مع تسجيل نوع التغيير ( إضافة، حذف، أو تعديل ) . إنشاء استعلام PIVOT أو ما يعرف بالإستعلام Crosstab بعد الانتهاء من المقارنة في الخطوة السابقة ، يتم إنشاء استعلام من نوع Pivot أو Crosstab ( استعلام جدولي كما يسمى في آكسس الواجهة العربية ) ؛ وهو يستخدم لتحويل البيانات من شكل الصفوف إلى شكل الأعمدة ( إن صح التعبير ) ، مما يجعل هذه البيانات أكثر تنظيماً وأسهل في التحليل و القراءةً . والهدف منه هو عرض التغييرات بطريقة منظمة باستخدام الحقول المشتركة بين الجدولين . فتح الاستعلام في نهاية الكود ، يتم فتح الاستعلام الذي يعرض الفروقات والتغيرات بين الجدولين بشكل عادي . ⭐ وظائف أخرى يتم استدعائها لأنشاء الجدول DifferencesTable بعد التأكد من وجوده أو لا . وأخرى لإنشاء الإستعلام الذي يحتوي التغيرات التي تم تعقبها :- وظيفة التأكد من وجود الجدول أو لا :- Function TableExists(tableName As String) As Boolean Dim db As DAO.Database Dim tdf As DAO.TableDef TableExists = False Set db = CurrentDb For Each tdf In db.TableDefs If tdf.Name = tableName Then TableExists = True Exit For End If Next tdf End Function في حال عدم وجود الجدول DifferencesTable ، سيتم استدعاء هذا الـ Sub لإنشائه مع الحقول التي سنحتاجها لعرض البيانات المختلفة في الجدولين :- Sub CreateDifferencesTable(db As DAO.Database) Dim tdf As DAO.TableDef Set tdf = db.CreateTableDef("DifferencesTable") tdf.Fields.Append tdf.CreateField("ID", dbLong) tdf.Fields.Append tdf.CreateField("ChangeType", dbText, 50) tdf.Fields.Append tdf.CreateField("FieldName", dbText, 50) tdf.Fields.Append tdf.CreateField("OldValue", dbMemo) tdf.Fields.Append tdf.CreateField("NewValue", dbMemo) db.TableDefs.Append tdf End Sub بعد تتبع التغيرات والفروقات ، سيتم انشاء استعلام باسم Foksh ، لعرض التغيرات التي تم التعرف عليها :- Sub CreatePivotQuery(table1 As String, table2 As String) Dim queryDef As DAO.queryDef Dim sql As String sql = "TRANSFORM First('" & table1 & " ' & [OldValue] & ' - ' & '" & table2 & " ' & [newvalue]) AS dd " & _ "SELECT DifferencesTable.ID " & _ "FROM DifferencesTable " & _ "GROUP BY DifferencesTable.ID " & _ "PIVOT DifferencesTable.FieldName;" On Error Resume Next CurrentDb.QueryDefs.Delete "Foksh" On Error GoTo 0 Set queryDef = CurrentDb.CreateQueryDef("Foksh", sql) Set queryDef = Nothing End Sub وأخيراً وليس آخراً :- UnMatched.accdb وهذه صورة للبرنامج :-

السلام عليكم 🙂 في الواقع انا خسارتي كبيرة لغيابي عن المنتدى لفترات طويلة ، لأني ما اشوف و اواكب واتعلم واستفيد من مثل هذه الابداعات الجميلة 🙂 شكرا لك اخوي ابو جودي 🙂 جعفر