متعقب التغييرات ⭐ هدية ~ متعقب التغييرات الذكي 2024⭐

[Foksh]

السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء )

قمت بتنفيذ فكرة تعقب التغييرات بين الجداول والمبنية على فكرة الأستاذ @ابو البشر ( مشكوراً  ) مع إجراء بعض التعديلات ، بحيث تم منح المستخدم الحرية في اختيار جدولين ومفتاح ربط أساسي و مشترك فيما بينهم بشكل بسيط وسهل ، ولا يحتاج الأمر لأي مكتبات أو دعم خارجي .

⭐ ما احتجنا له هو كومبوبوكس عدد 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

 

وهذه صورة للبرنامج :-

 

تم تعديل نوفمبر 10 بواسطه Foksh
تصحيح بعض الأخطاء الإملائية

[Moosak]

وعليك السلام ورحمة الله وبركاته أيها العزيز مستر @Foksh 😊🌹

شكر الله سعيك .. وبارك الله جهدك .. وأحسن الله إليك .. 🙂🌷

 

إقتراح من مبتديء لسمو معاليك : 👍🏻😁
مع إيماني بكم الإبداع الذي يحويه هذا الجهد ..
إلا أني أقترح عليك أن يكون مع هذه الدرة الرائعة إضافة مثال من الجداول والبيانات لكي يتضح للمتابعين والمستفيدين كيفية الاستخدام ونرى صورة مباشرة للنتيجة .. فبالمثال يتضح المقال 😄🖐🏻

[jo_2010]

في 10‏/11‏/2024 at 01:01, Foksh said:

السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء )

قمت بتنفيذ فكرة تعقب التغييرات بين الجداول والمبنية على فكرة الأستاذ @ابو البشر ( مشكوراً  ) مع إجراء بعض التعديلات ، بحيث تم منح المستخدم الحرية في اختيار جدولين ومفتاح ربط أساسي و مشترك فيما بينهم بشكل بسيط وسهل ، ولا يحتاج الأمر لأي مكتبات أو دعم خارجي .

⭐ ما احتجنا له هو كومبوبوكس عدد 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 484 kB · 25 downloads

 

وهذه صورة للبرنامج :-

 

استاذى الفاضل 

قمت بنقل النموذج الى برنامجى واعطى هذة الرسالة

[Foksh]

21 ساعات مضت, Moosak said:

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

أهلا مهندسنا الغالي .. جزاك الله خيراً على ما أسلفت ، هل الصورة أدناه تكفي  !!!

 

 

8 ساعات مضت, jo_2010 said:

قمت بنقل النموذج الى برنامجى واعطى هذة الرسالة

 

 

أخي جو أسعد الله مسائك ، هل قمت بتوفير المطلوب بشكل عام ، وهو :-

وجود جدولين بينهم حقول متشابهة ، فمثلاً اذا اخترت جدول المستخدمين وجدول الطلاب ( فهل بينهم حقول متشابهة ؟؟؟ ) أكيد لا فكيف سيكون هناك مقارنة بين جدولين للإيجاد الفرق .

 

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

فلا اعلم ما الجداول التي اخترتها ، ولا طبيعة وبنية الجداول والحقول فيهما .

[gamal gamal]

سلمت يداك أخى الكريم على ابداعاتك

[Foksh]

6 ساعات مضت, gamal gamal said:

سلمت يداك أخى الكريم على ابداعاتك

يسعدني مرورك العطر ..

ونرجو افادتنا بالتجربة ونتيجتها لغايات التطوير وتحسين الأداء وتلافي الأخطاء وإصلاحها