كيف أقوم بعمل جملة شرطية تعتمد على لون الخلايا في جميع الأوراق داخل الملف ؟

[شبكة النبراس الإسلامية]

كيف أقوم بعمل جملة شرطية تعتمد على لون الخلايا في جميع الأوراق داخل الملف ؟

بمعنى :

يوجد لدي ملف اكسل في مجموعة من الأوراق (sheets) ويوجد بعض الخلايا تتلون باللون الأصفر تلقائيا في هذه الأوراق بحسب معادلة كنت قد وضعتها.

المطلوب :

لقد قمت بنشاء زر أريد من خلال أن أكتب جملة شرطية بحيث اذا كان يوجد أي خلية من الخلايا داخل أي ورقة معلمة باللون الأصفر فإنه يجمعها ثم يظهر لي مربع حوار يقول لي على سبيل المثال :

 (لديك 5 خلايا ملونة باللون الأصفر)وفي حال لا يوجد أي خلية ملونة باللون الأصفر فإنه يقول لي (لا يوجد لديك خلايا ملونة) 

فما هي الأكود التي أكتبها في الزر ليظهر لي المطلوب ؟ أفيدوني مشكورين.

[أبوبسمله]

اتفضل اخى 

دى محاوله بسيطه منى 

على قد حالى \

بالفرض الخليه اللى هنجمع فيها هيا m9

Private Sub Workbook_Open()
Dim cl As ColorScaleCriterion
For Each cl In Me.Worksheets

 If cl = BackColor = 65535 Then
 
 ActiveCell.FormulaR1C1 = "=SUM(RC[-6],RC[-4],RC[-2])"
 Range("M10").Select
 End If
Next
End Sub

بالتوفيق

[أبوبسمله]

فى حاجه غلط فى الكود 

هوا اشتغل معايا وباعدين مش عاوز يشتغل تانى وبيدينى خطأ 

الله اعلم فى ايه 

 

[شبكة النبراس الإسلامية]

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

[شبكة النبراس الإسلامية]

للرفع

[سليم حاصبيا]

جرب هذا الملف 

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

فقط حدد اللون من خلال تحدبد اي خلية ملونة

count_colore 1.rar

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

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

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

19 ساعات مضت, شبكة النبراس الإسلامية said:

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

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

لم ينبه أحد الأعضاء على صاحب السؤال أن يقوم بإرفاق ملف لتيسير الأمر ... حاولوا تساعدوني في هذا الأمر

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

تقبلوا تحياتي

[شبكة النبراس الإسلامية]

2 ساعات مضت, ياسر خليل أبو البراء said:

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

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

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

لم ينبه أحد الأعضاء على صاحب السؤال أن يقوم بإرفاق ملف لتيسير الأمر ... حاولوا تساعدوني في هذا الأمر

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

تقبلوا تحياتي

أحسنت أخي الكريم يوجد في الملف تنسيق شرطي في 5 صفحات تقريبا بحيث تتلون الخلايا باللون الأصفر اذا تحقق الشرط وتقريبا عدد الخلايا الملونة يتغير يوميا تلقائيا 

فالهدف من الزر اذا ضغطت عليه يخبرني بعدد الخلايا الملونة باللون الأصفر تحديداً وإذا لا يوجد خلايا ملونة يظهر أنه لا يوجد خلايا ملونة وهكذا...

6 ساعات مضت, سليم حاصبيا said:

جرب هذا الملف 

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

فقط حدد اللون من خلال تحدبد اي خلية ملونة

count_colore 1.rar

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

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

أخي الكريم بدون ملف مرفق سيطول الموضوع بدون داعي

ارفق ملفك ليستطيع الأخوة الكرام تقديم المساعدة

لا أحبذ التخمين في حل المشكلات إلا في حالات خاصة

[شبكة النبراس الإسلامية]

يوجد في المرفقات مثال سيتم شرحه الآن :

يوجد في الورقة الأولى (اظهار الخلايا الملونة) زر هذا الزر أريد أن تكون وظيفته اذا ضغطت عليه يظهر لي رسالة يقول فيها عدد الخلايا الملونة هي 6 كما في الملف ، وإذا لم توجد خلايا ملونة يقول لي لا يوجد لديك خلايا ملونة.

في ورقة الطلاب 1 خلايا ملونة بالاصفر بناء على تنسيق شرطي وضعته للخلايا.

في ورقة الطلاب 2 لا يوجد خلايا ملونة.

في ورقة الطلاب 3 يوجد 3 خلايا ملونة.

المفترض الآن اذا ضغطت انا على الزر الذي في الورقة الأولى تظهر لي نافذة تخبرني بأن لدي 6 خلايا ملونة.

 

ملف تجربة.rar

[أبوبسمله]

عندك حق اخى ياسر 

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

ووالله ما هى الا محاولة بائسه لم تظبط معى ولا اعرف لماذا 

ساكون حريص دائما اخى ياسر اعزك الله 

جزاكم الله خيرا 

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

أخي الكريم

يرجى تغيير اسم الظهور ليعبر عن شخصكم الكريم

إليك الكود التالي عله يفي بالغرض

Sub CountCells()
    Dim Ws As Worksheet, Cel As Range, I As Integer
    Set Ws = ActiveSheet
    
    Application.ScreenUpdating = False
        For Each Ws In ThisWorkbook.Worksheets
            For Each Cel In Ws.Range("I7:I" & Ws.Cells(Rows.Count, "I").End(xlUp).Row)
                If GetCellColorForReals(Cel) = 65535 Then I = I + 1
            Next Cel
        Next Ws
        
        If I = 0 Then
            MsgBox "لا يوجد خلايا ملونة", 64
        Else
            MsgBox "عدد الخلايا الملونة يساوي " & I
        End If
    Application.ScreenUpdating = False
End Sub

Function GetCellColorForReals(R As Range) As Long
    GetCellColorForReals = R.DisplayFormat.Interior.Color
End Function

تقبل تحياتي

 

[شبكة النبراس الإسلامية]

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

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

أخي الكريم ما هي نسخة الأوفيس التي تستخدمها؟

هل قمت بنسخ الكود بشكل صحيح ووضعه في موديول جديد ..؟

لماذا تظهر اللغة العربية لديك بحروف غريبة ..تأكد من إعدادات اللغة العربية في نسخة الويندوز لديك؟

يمكن لأحد الأخوة المتابعين تجربة الكود وموافاتنا بعمل الكود من عدم عمله

تقبل تحياتي

[رجب جاويش]

أخى ياسر

أخى شبكة النبراس الإسلامية

الكود يعمل عندى بشكل ممتاز

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

أنا اعمل على أوفيس 2010

[صلاح الصغير]

تجربة ناجحة

تمام ا / ياسر

[أبوبسمله]

جربت الكود شغال 

ومرفق النتيجه 

جزاك الله كل خير اخى ياسر 

ملف تجربة1.rar

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

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

استبدل الرسالة التي باللغة العربية للغة الإنجليزية كمحاولة ..

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

أمر آخر ما هي نسخة الأوفيس التي تعمل عليها ؟؟ لربما يكون السبب في نسخة الأوفيس مع الخاصية DisplayFormat

 

[شبكة النبراس الإسلامية]

نزلت الملف المرفق الذي وضعه الأخ أحمد الفلاحجي مازالت تظهر نفس المشكلة ونفس الرسالة ولا تظهر لي الرسالة التي بها debug 

نسخة الويندوز عندي هي 2007

[شبكة النبراس الإسلامية]

قمت الآن بتجربة الملف على جاهز آخر مسطب عليه الاصدار 2007 وظهرت نفس الرسالة ، ولكن عندما جبرته على نسخة 2010 اشتغل تمام.

فهل يمكن حل مشكلة 2007 ؟

تم تعديل يناير 27, 2016 بواسطه شبكة النبراس الإسلامية

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

أخي الكريم (اللي مش عارف اسمه) وقلت له يغير اسمه لاسم يعبر عن شخصه الكريم

إليك الكود التالي عله يعمل على 2007

Sub CountColoredCellsCF()
    Dim Ws As Worksheet, I&
    
    For Each Ws In ThisWorkbook.Worksheets
        I = I + CountCFCells(Ws.Range("I6").CurrentRegion, 6)
    Next Ws
    
    MsgBox "عدد الخلايا الصفراء يساوي = " & I
End Sub

Function CountCFCells(Rng As Range, ColorIndex As Long) As Long
    Dim I&, J&, Tmp$, Str1$
    Dim CfCell As Range
    Dim FC As FormatCondition, IIFlg As Boolean
    
    For Each FC In Rng.FormatConditions
        If FC.Interior.ColorIndex = ColorIndex Then Exit For
    Next FC
    
    If FC Is Nothing Then Exit Function
    
    Str1 = FC.Formula1
    For I = 1 To Len(Str1)
        Tmp = Mid(Str1, I, 1)
        If ("0123456789" Like "*" & Tmp & "*") Then
            IIFlg = True
        Else
            If IIFlg Then Exit For
        End If
    Next I
    
    Tmp = Right(Str1, Len(Str1) - I + 1)
    
    For Each CfCell In Rng
        Str1 = "=" & CfCell.Address & Tmp
        If Rng.Worksheet.Evaluate(Str1) = True Then J = J + 1
    Next CfCell
    
    CountCFCells = J
End Function

تقبل تحياتي

[أبوبسمله]

اخى الفاضل 

عندى نسخه ويندوز 2007 والاوفيس 2010 

وفى 2003 اعطانى مشكله فى السطر التالى 

 GetCellColorForReals = R.DisplayFormat.Interior.Color

سوف اجرب الكود الذى ارفقه الاخ ياسر اخر رد واوفيكم بالنتيجه

 

[مختار حسين محمود]

أخى ياسر  بارك الله فيك وجزاك خيرا

الى كل الأخوة بالمنتدى رجاء

لابد من ارفاق ملف للعمل عليه لنتجنب البعد عن الفرضيات والتخمينات

تحديث الأوفيس لديكم على الأقل  2010 للحصول على أفضل الامكانات فى الأوفيس وحتى لا تحدث لدينا مثل هذه الاشكاليات ونوفر وقتنا وجهدنا

وشخصيا أعجبنى الكود الأول  لأنه أبسط  و أسهل

وأستاذن أستاذى ياسر فى هذه الصورة الجديدة للكود :

تم الاستغناء عن الدالة GetCellColorForReals   و الرقم  65535  الذى يمثل اللون الأصفر  والتعويض عنه بـ ColorIndex = 6

Option Explicit
Sub CountCellsByColorIndex()
    Dim Ws As Worksheet, Cel As Range, i As Integer
    Application.ScreenUpdating = False
        For Each Ws In ThisWorkbook.Worksheets
            For Each Cel In Ws.Range("I7:I" & Ws.Cells(Rows.Count, "I").End(xlUp).Row)
                 If Cel.DisplayFormat.Interior.ColorIndex = 6 Then i = i + 1  ' ColorIndex =6 هو اللون الأصفر
            Next Cel
        Next Ws
        If i = 0 Then
            MsgBox "لا يوجد خلايا ملونة ", 64
        Else
            MsgBox "عدد الخلايا الملونة يساوي " & i
        End If
    Application.ScreenUpdating = True
End Sub

 

تحياتى

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

بارك الله فيك أخي الحبيب مختار

أعتقد المشكلة ليست في الـ Color أو ColorIndex إنما المشكلة في الخاصية DisplayFormat حيث لا تعمل مع النسخ القديمة

جزيت خيراً على مساهماتك القيمة والممتعة

تقبل تحياتي

[مختار حسين محمود]

نعم أخى و حبيبى و أستاذى  ياسر 

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

تحياتى وتقديرى