مطلوب كود عمل فورمات للخلية عند التعديل

[ehabaf2]

السلام عليكم الاخوة الفاضل 

كل عام وحضراتكم و الاسرة بالف خير و صحة و سعادة

رمضان كريم

محتاج كود VBA عند تعديل ما تم كتابته فى الخلية يتم تلوين الخلية باللون الاسود و النص باللون الابيض 

يعنى اذا كتبت اي حاجة في الخلية ثم قمت بالتعديل على ما تم كتابته يتم تلوين الخلية علشان اعرف ان الخلية ديه تم التعديل على محتواها

و هل ممكن بعد كده الغى الفورمات ديه بس بكلمة سر يعني محدش يعرف يلغيها غيرى

الف الف شكر لحضراتكم

و كل عام و حضراتكم بالف بخير وصحة و سعادة

[abouelhassan]

جرب اخى الكريم

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range

    For Each cell In Target
        If Not Intersect(cell, Me.UsedRange) Is Nothing Then
            cell.Interior.Color = RGB(0, 0, 0) ' Black color
            cell.Font.Color = RGB(255, 255, 255) ' White color
        End If
    Next cell
End Sub

كل عام وانتم بخير وصحه وسلامه 

[ehabaf2]

السلام عليكم استاذنا الفاضلabouelhassan

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

الف الف شكر لحضرتك و كل سنة وحضرتك و الاسرة الكريمة بالف خير و سعادة

[بلانك]

ياريت نفس الطلب

[abouelhassan]

تفضل أن شاء الله طلبك

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range

    For Each cell In Target
        If Not Intersect(cell, Me.UsedRange) Is Nothing Then
            cell.Interior.Color = RGB(0, 0, 0) ' Black color
            cell.Font.Color = RGB(255, 255, 255) ' White color
        End If
    Next cell
End Sub

 

[abouelhassan]

2 ساعات مضت, بلانك said:

هو نفس الكود السابق

اسف رمضان كريم

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range

    For Each cell In Target
        If Not Intersect(cell, Me.UsedRange) Is Nothing Then
            If cell.Value <> "" Then
                cell.Interior.Color = RGB(0, 0, 0) ' Black color
                cell.Font.Color = RGB(255, 255, 255) ' White color
            End If
        End If
    Next cell
End Sub

 

[بلانك]

اسف على الطلب مرة اخري ولكن احول اوضح لحضرتك ماذا اريد .. عند وضع اي قيمة في اي خلية لاتتغير لون الخلفية ولا الخط في اول مرة وعند حفظ الملف وتغير اي خلية بها بيانات تتحول الى اللون الاسود والخط الابيض اما الخلايا التي لمتتغير قيمتها تبقى كما هي ..... ( ملوحظة فكرة Track Changes )

[ehabaf2]

استاذنا الفاضل abouelhassan

رمضان كريم 

و الف شكر على مجهود حضرتك

للتوضيح المطلوب عند وضع اي قيمة في اي خلية لاتتغير لون الخلفية ولا الخط في اول مرة وعند حفظ الملف وتغير اي خلية بها بيانات تتحول الى اللون الاسود والخط الابيض اما الخلايا التي لم تتغير قيمتها تبقى كما هي

الكود اللى حضرتك كتبته الخلية تتغير لونها مع اول مرة بكتب فيها

و اكرر الف شكر لمجهو حضرتك

[abouelhassan]

فهمت

ان شاء الله يكون طلبك

 

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range

    For Each cell In Target
        If Not Intersect(cell, Me.UsedRange) Is Nothing Then
            If cell.Value <> cell.Text Then
                cell.Interior.Color = RGB(0, 0, 0) ' Black color
                cell.Font.Color = RGB(255, 255, 255) ' White color
            End If
        End If
    Next cell
End Sub

 

[بلانك]

اسف للمرة المليون على تعب حضرتك لم يصل للحل المطلوب الكود المطلوب نفس بل هو الموجود في تبويب ( Reviwe >>>> Track Changes ) تعقب التغييرات في ملف الاكسل  إنظر للصورة

[abouelhassan]

اسف اخى ممكن تجرب هذا الكود أن شاء الله يضبط

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range
    Dim rng As Range

    Set rng = Me.Range("E:H,J:K")

    For Each cell In Target
        If Not Intersect(cell, rng) Is Nothing Then
            If cell.Value <> cell.Text Then
                cell.Interior.Color = RGB(0, 0, 0) ' Black color
                cell.Font.Color = RGB(255, 255, 255) ' White color
            Else
                cell.Interior.ColorIndex = xlNone ' No color
                cell.Font.ColorIndex = xlAutomatic ' Automatic font color
            End If
        End If
    Next cell
End Sub

للاختبار اخى الكريم هذا الكود يقوم بتحديد نطاق الخلايا المراد مراقبتها (E:H و J:K)، وعند تغيير أي قيمة في هذه الخلايا، يتم تغيير لون الخلفية إلى الأسود ولون النص إلى الأبيض. إذا لم يحدث أي تغيير في القيمة، ستظل الخلية كما هي. ويمكنك تعديل النطاق كما تحب إذا نجح الكود

تحياتي 

[بلانك]

اخي العزيز abouelhassan اريد من الكود ان لا يعمل والخلايا فارغة ولكن عند وضع قيم او نص والحفظ وغلق الملف ثم عند فتحة وتغير اي قيمة او تص يبدا بتغير الخلية باللون الاسود مع الخط الابيض كما ذكرت  ( الفكرة معرفة من دخل للملف وغير من قيم الخلايا سواء نص او ارقام) ارجو باني قد وضحت الفكرة !!!!!!!!!

[abouelhassan]

سامحنى اخى احاول المساعدة قدر الامكان والله

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

Dim cellState As New Collection

Private Sub Workbook_Open()
    Dim ws As Worksheet
    Dim cell As Range

    For Each ws In ThisWorkbook.Worksheets
        For Each cell In ws.UsedRange
            If Not IsEmpty(cell.Value) Then
                cellState.Add cell.Value, cell.Address
            End If
        Next cell
    Next ws
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    cellState.Clear
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range

    For Each cell In Target
        If Not Intersect(cell, Me.UsedRange) Is Nothing Then
            If Not IsEmpty(cell.Value) And cell.Value <> cell.Text Then
                cell.Interior.Color = RGB(0, 0, 0) ' Black color
                cell.Font.Color = RGB(255, 255, 255) ' White color
                If cellState.Contains(cell.Address) Then
                    cellState.Remove cell.Address
                End If
                cellState.Add cell.Text, cell.Address
            End If
        End If
    Next cell
End Sub

 

[بلانك]

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

[abouelhassan]

 يبدو أن هناك خلط في الاستخدام. يجب وضع الكود في وحدة VBA للمصنف (Module) بدلاً من وضعه في حدث الملف أو حدث الورقة. قم باتباع الخطوات التالية:

1. افتح المصنف واذهب إلى عارض المشروع (عن طريق الضغط على ALT + F11).

2. في عارض المشروع، انقر بزر الماوس الأيمن على أحد الأوراق في الجزء الأيسر، ثم اختر "Insert" > "Module" لإضافة وحدة جديدة.

3. انسخ والصق الكود في الوحدة الجديدة.

4. أغلق نافذة VBA واحفظ التغييرات.

5. أعد فتح الملف وجرب تغيير قيم في الخلايا لرؤية التأثير.

تم تعديل مارس 16 بواسطه abouelhassan

[بلانك]

لم يحدث شئ

كود عمل فورمات للخلية عند التعديل.xlsm

[abouelhassan]

الكود يعمل عندى اخى

وللتأكيد جرب التحديث

Dim cellState As New Collection

Private Sub Workbook_Open()
    Dim ws As Worksheet
    Dim cell As Range

    For Each ws In ThisWorkbook.Worksheets
        For Each cell In ws.UsedRange
            If Not IsEmpty(cell.Value) Then
                cellState.Add cell.Value, cell.Address
            End If
        Next cell
    Next ws
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    cellState.Clear
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim cell As Range

    For Each cell In Target
        If Not Intersect(cell, Sh.UsedRange) Is Nothing Then
            If Not IsEmpty(cell.Value) And cell.Value <> cell.Text Then
                cell.Interior.Color = RGB(0, 0, 0) ' Black color
                cell.Font.Color = RGB(255, 255, 255) ' White color
                If cellState.Contains(cell.Address) Then
                    cellState.Remove cell.Address
                End If
                cellState.Add cell.Text, cell.Address
            End If
        End If
    Next cell
End Sub

أعتذر عن ذلك. دعوني أوضح الكود بشكل أدق. يمكنك استخدام هذا الكوديرجى وضع هذا الكود في وحدة VBA جديدة كما ذكرت سابقًا، ثم قم بحفظ الملف وأعد فتحه وجرب تغيير القيم في الخلايا. إذا لم يعمل، فقد يكون هناك مشكلة في الإعدادات الخاصة بالملف. يمكنك محاولة إعادة الكود بعد حفظ الملف باسم جديد وفتحه للتحقق من عمل الكود.

[بلانك]

abouelhassan  للاسف لم يعمل عندي علما الويندوز عندي 10 والاوفيس 2010 ولا اعرف السبب وعلى العموم انا بشكرك على تعبك معي ورمضان كريم

[abouelhassan]

ان شاء الله هيعمل على office 2010

Dim cellState As New Collection

Private Sub Workbook_Open()
    Dim ws As Worksheet
    Dim cell As Range

    For Each ws In ThisWorkbook.Worksheets
        For Each cell In ws.UsedRange
            If Not IsEmpty(cell.Value) Then
                cellState.Add cell.Value, cell.Address
            End If
        Next cell
    Next ws
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    cellState.Clear
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range
    Dim ws As Worksheet

    Set ws = Target.Worksheet

    For Each cell In Target
        If Not Intersect(cell, ws.UsedRange) Is Nothing Then
            If Not IsEmpty(cell.Value) And cell.Value <> cell.Text Then
                cell.Interior.Color = RGB(0, 0, 0) ' Black color
                cell.Font.Color = RGB(255, 255, 255) ' White color
                If cellState.Contains(cell.Address) Then
                    cellState.Remove cell.Address
                End If
                cellState.Add cell.Text, cell.Address
            End If
        End If
    Next cell
End Sub

 

[بلانك]

abouelhassan برجاء مني لا تتعبك نفسك وشكرا جزيلا على تعبك . العيب قد يكون من نسخة الاوفيس وفقك الله

[حسونة حسين]

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

جرب هذا التعديل

كود عمل فورمات للخلية عند التعديل.xlsm

[بلانك]

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

[ehabaf2]

السلام عليكم استاذنا الفاضل abouelhassan  الف الف شكر لتعب حضرتك و مجهودك ربنا يجعله فى ميزان حسناتك

 

السلام عليكم استاذنا الفاضل حسونة حسين  الف الف شكر لتعب حضرتك و مجهودك الكود يعمل بكفاءة و ينفذ المطلوب ربنا يحفظك و يعزك ويبارك فيك 

[بلانك]

هل اطمع في كرم الاستاذ حسونه في تكملة الكود لمعرفة قيمة الخلية القديمة؟؟؟

[حسونة حسين]

هذا موضوع اخر اخي الغالي

قم بفتح موضوع بالطلب الجديد