تعقب التغييرات (هدية للمنتدى)

[أبوعيد]

السلام عليكم

أحبابي الكرام 

فكرة هذا الملف هو نفس خاصبة تعقب التغييرات التي بالاكسل

عند فتح المرفق تجد ثلاث أوراق

الورقة الاولى : يناير       الورقة الثانية : فبراير

الورقة الثالثة : التغييرات

غير أي خلية في الجدولين الموجودين في الورقة الأولى والثانية

ستجد في ورقة التغييرات البيانات الآتية :

اسم الورقة  ـ  عنوان الخلية  ـ  القيمة الجديدة  ـ  القيمة السابقة  ـ  التاريخ  ـ  الساعة

أرجو أن ينال أعجابكم

تعقب التغييرات.rar

[ياسر خليل أبو البراء]

 

بسم الله ما شاء الله عليك أبو عيد

أعمالك رائعة وتدرس ...

اسمح لي بإضافة بسيطة جداً إذا كان الأمر لا يزعجك ..

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

ليصبح الكود بهذا الشكل في نهاية الأمر

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim LR As Long
    
    If Sh.Name = "يناير" Or Sh.Name = "فبراير" Then
        LR = Sheets(3).Cells(Rows.Count, "A").End(xlUp).Row + 1
        If Target.Column < 10 And Not IsEmpty(Target) Then
            With Sheets(3)
                .Cells(LR, 1) = ActiveSheet.Name
                .Cells(LR, 2) = Target.AddressLocal
                .Cells(LR, 3) = Target.Value
                .Cells(LR, 4) = [vv1].Value
                .Cells(LR, 5) = Format(Date, "dd-mm-yyyy")
                .Cells(LR, 6) = Format(Now, "h:mm:ss")
            End With
        End If
    End If
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Name = "يناير" Or Sh.Name = "فبراير" Then
        [vv1] = ActiveCell.Value
    End If
End Sub

والملف التالي فيه تطبيق الكود ...

تقبل وافر تقديري واحترامي

 

حمل الملف من هنا

[أبوعيد]

شكرا لك أخي أبوالبراء على مد يد العون لإخوانك حتى يصلوا للقمة

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

وأنت اسمح لي بتطوير هذا الكود لجعله ديناميكيا كما يأتي

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim LR As Long, N As Integer

N = Sheets.Count
    If Sh.Index < N Then  
        LR = Sheets(N).Cells(Rows.Count, "A").End(xlUp).Row + 1
        If Target.Column < 10 And Not IsEmpty(Target) Then
            With Sheets(N)
                .Cells(LR, 1) = ActiveSheet.Name
                .Cells(LR, 2) = Target.AddressLocal
                .Cells(LR, 3) = Target.Value
                .Cells(LR, 4) = [vv1].Value
                .Cells(LR, 5) = Application.UserName
                .Cells(LR, 6) = Format(Date, "dd-mm-yyyy")
                .Cells(LR, 7) = Format(Now, "h:mm:ss")
            End With
        End If
    End If
End Sub

التعديلات هي : يجب أن تكون ورقة التغييرات آخر ورقة في الملف

وأي ورقة سيتم التغيير عليها (غير ورقة التغييرات) سيتم تسجيل بياناتها

N = Sheets.Count
    If Sh.Index < N Then

إضافة اسم المستخدم الذي قام بالتغيير

.Cells(LR, 5) = Application.UserName

التعديلات تجدها في المرفق

تعقب التغييرات1.rar

[ماكس]

ما شاء الله ما شاء تبارك الله أخواني أبو عبيد و ياسر خليل

هذا بالضبط ماكنت أقصده

بتعديلاتكم الرائعة أكتمل الكود

اشكركم على إهتمامكم 

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

تقبلوا تحياتي الخالصة

أخي ابو عيد

هل بالأمكان إضافة عمود به قيمة الخلية إذا حذفت ان تكوم في عمود خاص بها

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

ليصبح أسم الكود تعقب التغييرات والمحذوف

ودمت بود أخي الكريم

تم تعديل مارس 28, 2016 بواسطه ماكس

[أبوعيد]

تفضل

 

تعقب التغييرات والحذف.rar

[ماكس]

ما شاء الله أخي ابو عيد أبدعت بصراحة ولك كل الشكر والتقدير

لكن هنالك خلل بسيط في حال التظليل أكثر من عمود وخلية

اتمنى النظر في ذلك

[أبوعيد]

تم حل المشكلة

تفضل

تعقب التغييرات والحذف1.rar

[محمد حسن المحمد]

السلام عليكم ورحمة الله وبركاته

جزاكم الله خيراً وبارك بكم على هذا التناغم في العمل ..كلٌّ يعطي ...والنتيجة فائدة للجميع

بارك الله بجهودكم.

[ماكس]

أشكرك أخي ابو عيد

لو سمحت مالمقصود ب هذا الرمز في الكود [vv1] 

[ياسر خليل أبو البراء]

أخي الكريم ماكس

الخلية VV1 يمكنك التنقل إليها عن طريق صندوق الاسم على يسار شريط المعادلات ...

اكتب في الصندوق VV1 للانتقال إلى الخلية

[أبوعيد]

السلام عليكم

سؤال : كيف يسيتطيع الكود معرفة القيمة السابقة (التي كانت مكتوبة في الخلية ) قبل التغيير ؟

حواب : عن طريقة الخلية VV1  لأنها تقوم بحفظ قيمة الخلية قبل التغيير

 

عند اختيار أي خلية من الجدول تقوم الخلية VV1 مباشرة بتسجيل القيمة الموجودة ( قبل أي تغيير )

وبعد عملية التغيير يكون أمام الكود قيمتين لكل خلية 

القيمة الأولى : في الخلية VV1 ( قبل التغيير )

القيمة الثانية : في الخلية نفسها ( بعد التغيير )

يقوم الكود بعد ذلك بوضع القيمتين في أماكنهما المناسبة في صفحة التغييرات

تحت عمود (القيمة السابقة ) و ( القيمة الجديدة )

 

 

تم تعديل مارس 29, 2016 بواسطه أبوعيد

[ماكس]

شكرا لكم اخي ابو عيد على المجهود في الشرح

[رسول]

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

شاشة دخول لأكثر من مستخدم والسرى 2014 وممكن تعديله - Copy.rar

[أبوعيد]

نعم صحيح لأنك تعمل على إصدار 2003 وهو قديم

تم التحديث 

جرب المرفق

شاشة دخول - .rar