عبد الفتاح كيرة قام بنشر يونيو 6, 2010 قام بنشر يونيو 6, 2010 (معدل) السلام عليكم إخوتى الكرام قابلنى هذا الكود المحكم و المجرب لتلوين الخلايا حسب قيمتها و هو يستخدم فى تمييز الطالب الراسب فى الكنترول شيت أرجو رأيكم وملاحظاتكم عليه Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range, r As Range Application.ScreenUpdating = False With Me Set r = .Range("C4:K39") On Error Resume Next For Each c In r If c.Value <> vbNullString Then With c Select Case .Value Case "G" ' Change font color .Font.ColorIndex = 10 ' 10 = Green ' Change background color '.Interior.ColorIndex = 10 Case "Y" .Font.ColorIndex = 6 ' 6 = Yellow .Interior.ColorIndex = 6 Case Is < 15 '.Font.ColorIndex = 3 '3 = Red .Interior.ColorIndex = 3 Case Else .Font.ColorIndex = 1 '1 = Black '.Interior.ColorIndex = 2 End Select End With End If Next c End With Set r = Nothing Application.ScreenUpdating = True End Sub تم تعديل يونيو 6, 2010 بواسطه kemas
هشام شلبى قام بنشر يونيو 6, 2010 قام بنشر يونيو 6, 2010 السلام عليكم =========== الكود ممتاز واعتقد انه سيخفف من حجم الشيت بالاستغناء عن التنسيقات الشرطية. ولكن سنحاول معا لتطبيقة على اعمدة معينة بدلا من مدى متكامل تحياتى لك اخى كيماس
اوفيس 2003 قام بنشر يونيو 6, 2010 قام بنشر يونيو 6, 2010 موضع راااااااااااااائع هل ممكن من مثال اكثر توضيح
عبد الفتاح كيرة قام بنشر يونيو 6, 2010 الكاتب قام بنشر يونيو 6, 2010 و عليكم السلام أخى هشام أنا جربت الكود على عمود واحد Set r = .Range("C4:K39") نستخدم مثلا Set r = .Range("C2:c500") ويمكن اختصار جملة case لتكون حالتين فقط أردت فقط فكرة الكود و هناك أشياء جديدة على فى هذا الكود مثل With Me إشارة للصفحة أو الورقة الموضوع فيها الكود و If c.Value <> vbNullString Then طريقة الإشارة للخلية الخالية أخانا office2003 يخيل لى الكود بهذا صار واضحا تحيتى لكم
هشام شلبى قام بنشر يونيو 6, 2010 قام بنشر يونيو 6, 2010 السلام عليكم =========== الاخ office 2003 تفضل office 2003.rar
هشام شلبى قام بنشر يونيو 6, 2010 قام بنشر يونيو 6, 2010 السلام عليكم ========== الاخ kemas بعد تجربة الكود وجدت به عيب لا يصير مع برامج الكنترول وهو عند تغير الحالة لا يمحو اللون "اظنك فاهمنى" فيجب اضافة السطر التالى الى الكود If Not Intersect(Target, Range("C4:K39")) Is Nothing Then Select Case Target هذا والله اعلم ولكن انظر الى هذا الكود وما له من تعدد فى الحالات ويتغلب على مشكلة محو اللون عند تغير الحالة Private Sub Worksheet_Change(ByVal Target As Range) Dim icolor As Integer If Not Intersect(Target, Range("A1:F100")) Is Nothing Then Select Case Target Case "Y" icolor = 3 Case "G" icolor = 12 Case "F" icolor = 5 Case "X" icolor = 9 Case "Z" icolor = 3 Case "áå ÏæÑ ËÇäì Ýì ãæÇÏ" icolor = 33 Case Else 'ويمكن زيادة الحالات End Select Target.Interior.ColorIndex = icolor End If End Sub شاهد المرفق كود يلون عند ارقام معينة.rar
عبد الفتاح كيرة قام بنشر يونيو 7, 2010 الكاتب قام بنشر يونيو 7, 2010 (معدل) مفهوم أخ هشام ملاحظة ممتازة جارى التجربة ممكن شرح للسطر الذى أضفته و فائدته If Not Intersect(Target, Range("C4:K39")) Is Nothing Then Select Case Target تم تعديل يونيو 7, 2010 بواسطه kemas
هشام شلبى قام بنشر يونيو 7, 2010 قام بنشر يونيو 7, 2010 السلام عليكم =========== هذا السطر هو الخاص بمحو اللون فى حالة ما اذا كانت الخلية "فى المدى المستهدف" فارغة او لا تحقق الشروط الاتية فيما بعد
عبد الفتاح كيرة قام بنشر يونيو 7, 2010 الكاتب قام بنشر يونيو 7, 2010 (معدل) لقد حذفت السطر المضاف والكود يعمل بكفاءة أعتقد أن هذا السطر فائدته الوحيدة هى حصر تنفيذ الجمل البرمجية التالية داخل المدى المحدد فقط وهو c4:k39انظر بعبارة أخرى حتى لا يرجع إكسل رسالة خطأ فى حال تحديدنا لخلية خارج النطاق المحدد Private Sub Worksheet_Change(ByVal Target As Range) Dim icolor As Integer Select Case Target Case Is < 15 icolor = 3 Case "G" icolor = 12 Case "F" icolor = 5 Case "X" icolor = 9 Case "Z" icolor = 3 Case "له دور ثانى فى مواد" icolor = 33 Case Else 'ويمكن زيادة الحالات End Select Target.Interior.ColorIndex = icolor End Sub تم تعديل يونيو 7, 2010 بواسطه kemas
هشام شلبى قام بنشر يونيو 7, 2010 قام بنشر يونيو 7, 2010 السلام عليكم =========== اخى kemas الكود لا يعمل بكفأة ولا حاجة وهذا الدليل طبعا انت شايف من المرفق عند المسح لا يتم الغاء اللون KEMAS.rar New ورقة عمل Microsoft Excel (2).rar
جلال محمد قام بنشر يونيو 7, 2010 قام بنشر يونيو 7, 2010 أخى هشام تحياتى لك ارجو من حضرتك تقوم بتطبيق ذلك علي عمودين مختلفين مثلا العمود( A1:A20 ) والعمود ( D1:D20 ) كما في المرفق وذلك عند كتابة الرقم Book1.rar
عبد الفتاح كيرة قام بنشر يونيو 7, 2010 الكاتب قام بنشر يونيو 7, 2010 (معدل) كود أبسط و أسهل Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A1:A100")) Is Nothing Then If Target.Value < 15 Then Target.Interior.ColorIndex = 3 Else Target.Interior.ColorIndex = 2 End If End If If ActiveCell.Value = "" Then ActiveCell.Interior.ColorIndex = 2 End If End Sub تم تعديل يونيو 7, 2010 بواسطه kemas
هشام شلبى قام بنشر يونيو 7, 2010 قام بنشر يونيو 7, 2010 السلام عليكم =========== اخى عادل حياك الله اقرأ المشاركة رقم 2 ولكن الحمد لله توصلت للحل وسارفقه بعد قليل تحياتى لك
عبد الفتاح كيرة قام بنشر يونيو 7, 2010 الكاتب قام بنشر يونيو 7, 2010 (معدل) هذا فيه علاج المشكلة عند مسح أى خلية تتلون باللون الأبيض المناقشات أثمرت خيرا و الحمد لله Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A1:A100")) Is Nothing Then If Target.Value < 15 Then Target.Interior.ColorIndex = 3 Else Target.Interior.ColorIndex = 2 End If End If If ActiveCell.Value = "" Then ActiveCell.Interior.ColorIndex = 2 End If End Sub تم تعديل يونيو 7, 2010 بواسطه kemas
هشام شلبى قام بنشر يونيو 7, 2010 قام بنشر يونيو 7, 2010 السلام عليكم =========== اخى kemas ان شاء الله لا مشاكل لطالما نبحث عن الجديد بس ما زالت المشكلة موجودة لان اللون الابيض هو لون ولا كلامى غلط بس ممكن للتغلب على مشكلة المسح باتغيير الاتى بالكود واتمنى ان تجربه Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A1:A100")) Is Nothing Then If Target.Value < 15 Then Target.Interior.ColorIndex = 3 Else Target.Interior.ColorIndex = 0 End If End If If ActiveCell.Value = "" Then ActiveCell.Interior.ColorIndex = 0 End If End Sub اليك المرفق عند كتابة العدد ستتلون الخلية وعند المسح سوف تكون بلا لون كيماس.rar
الحسامي قام بنشر يونيو 7, 2010 قام بنشر يونيو 7, 2010 السلام عليكم موضوع مهم وارجو التوفيق للجميع وحلول اكثر من رائعة ولاثراء الموضوع هذا كود مسح الخلايا If IsEmpty(Target.Cells) Then Target.Interior.ColorIndex = 0
هشام شلبى قام بنشر يونيو 7, 2010 قام بنشر يونيو 7, 2010 السلام عليكم =========== تمام يا عمدة وهذا البديل لها الذى ارفقته فى الكود خاصتى If ActiveCell.Value = "" Then ActiveCell.Interior.ColorIndex = 0
عبد الفتاح كيرة قام بنشر يونيو 7, 2010 الكاتب قام بنشر يونيو 7, 2010 ممتاز جدا أخى هشام نعم الأبيض هو لون و 0 يعنى بدون تعبئة ممتازة و الكود الآن يعمل بكفاءة و الحمد لله لكن يبقى السؤال لماذا عند ضغط مفتاح delete عند تحديد الخلية الملونة بالأحمر و مسحها لم ينفذ الشرط و تعود الخلية للون العادى يعنى بلا لون أو حتى أبيض هل ضغط مفتاح delete لا يعتبر تغييرا يعنى لا يندرج تحت الحدث change هذا هو السؤال أم أن هناك خطوة فى الكود تمنع ذلك أرجو أن يكون سؤالى مفهوما وشكرا لردودك التى استفدت منها جدا
عبد الفتاح كيرة قام بنشر يونيو 7, 2010 الكاتب قام بنشر يونيو 7, 2010 (معدل) شكرا للأخ عماد الحسامى اللمسات الأخيرة ممتازة جدا إذن توصلنا للكود النهائى هذا ' åÐÇ åæ ßæÏ ÇáÊáæíä ÇáäåÇÆí Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A1:A100")) Is Nothing Then If Target.Value < 15 Then Target.Interior.ColorIndex = 3 Else Target.Interior.ColorIndex = 0 End If End If If IsEmpty(Target.Cells) Then Target.Interior.ColorIndex = 0 End Sub تم تعديل يونيو 7, 2010 بواسطه kemas
الحسامي قام بنشر يونيو 7, 2010 قام بنشر يونيو 7, 2010 السلام عليكم نعم اخي العزيز هشام الكودان يعطينان نفس النتيجةويحملان نفس المبدأ لكن يجب التفريق ما بين activecel وما بين target وهما متشابهان الى درجة كبيرة جدا ولكن في البعض البرامج انت ملزم باختار احدهما بالتحديد target هي الخلية المختارة اي التي نقوم بأختيارها أما Activecell هي الخلية النشطة أي التى يكون المؤشر عليها فمثلا عند استخدام الاكواد في حالة Worksheet_Change activecell هي الخلية التالية بعد الضغط على Enter وليست الخلية المختارة بعكس Target تبقى الخلية نفسها حتى بعد الضغط على Enter وللمشاركة معكم هنا ملف بسيط يعطي الناجح لون والراسب لون اخر تلوين خلية.rar
جلال محمد قام بنشر يونيو 8, 2010 قام بنشر يونيو 8, 2010 شكرا للأخ عماد الحسامى اللمسات الأخيرة ممتازة جدا إذن توصلنا للكود النهائى فعلا كدة تمام ولكن ارجو من الاخوة تطبيق ذلك علي اكثر من عمود فالمواد في الشيت تكون كثيرة والتنسيقات الشرطية تختلف من مادة الي اخرى وجزى الله الجميع الأجر الوفير
هشام شلبى قام بنشر يونيو 10, 2010 قام بنشر يونيو 10, 2010 السلام عليكم =========== الاخ العزيز galal_mk طبعا اعرف الغرض من مشاركتك فعلا كدة تمام ولكن ارجو من الاخوة تطبيق ذلك علي اكثر من عمود فالمواد في الشيت تكون كثيرة والتنسيقات الشرطية تختلف من مادة الي اخرى وجزى الله الجميع الأجر الوفير واحدة واحدة ان شاء الله نوصل للهفنا المنشود اولا اطلع على الملف الاتى وقد طبقت التنسيق الشرطى بالكود على اربع لعمدة مختلفة وغير متجاورة ويمكن زيادة الشروط لتتلائم مع ما نريدة فى الشيت تحياتى شرطى عمود.rar
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.