تعديل بالكود

[mdsasa]

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

لو سمحتوا يا أخوة عندي إستفسار

  (run) عندما اضغط ع

 تتغير للون الأبيض ، (B) (C) (I) الخلايا بالأعمدة

 أريدها تحتفظ بنفس لونها الأصلي

الملف بالمرفقات .. بارك الله فيكم

 

2.xlsm

[شوقي ربيع]

Sub MM()
For G = 4 To 10
If Cells(G, 15) < 30 Then
If Cells(G, 9).Value > Range("G1").Value Then

'Cells(G, 2).Interior.ColorIndex = 40
'Cells(G, 3).Interior.ColorIndex = 42
'Cells(G, 9).Interior.ColorIndex = 40
MsgBox ("ÇáãæÙÝ : " & " " & Cells(G, 2) & " " & "¡ íäÊåí ÇáÅÔÊÑÇß ÈÊÇÑíÎ : " & " " & Cells(G, 9) & " " & "¡ æÈÇÞí ãä ÇáÃíÇã : " & Cells(G, 15) & " " & "íæã ")
'Cells(G, 2).Interior.ColorIndex = xlNone
'Cells(G, 3).Interior.ColorIndex = xlNone
'Cells(G, 9).Interior.ColorIndex = xlNone
End If
End If

Next
End Sub

 

[mdsasa]

شكراً جزيلاً لحضرتك أستاذ / شوقي

 هذا الجزء من الكود لا يعمل 

المفترض يلوّن ثم يرجع للّون الأصلي مرة أخري

'Cells(G, 2).Interior.ColorIndex = 40
'Cells(G, 3).Interior.ColorIndex = 42
'Cells(G, 9).Interior.ColorIndex = 40

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

 

 

تم تعديل ديسمبر 6, 2018 بواسطه mdsasa

[mdsasa]

☹️☹️

[mdsasa]

هل من حل يا أخوة ؟؟

[Emad Sabry]

15 دقائق مضت, mdsasa said:

هل من حل يا أخوة ؟؟

 بعد اذن استاذ شوقى رجع الالوان للخلايا اللى عاوزها

واستخدم الكود بالشكل دا 

Sub MM()
For G = 4 To 10
If Cells(G, 15) < 30 Then
If Cells(G, 9).Value > Range("G1").Value Then

MsgBox ("ÇáãæÙÝ : " & " " & Cells(G, 2) & " " & "¡ íäÊåí ÇáÅÔÊÑÇß ÈÊÇÑíÎ : " & " " & Cells(G, 9) & " " & "¡ æÈÇÞí ãä ÇáÃíÇã : " & Cells(G, 15) & " " & "íæã ")

End If
End If

Next
End Sub

 

تم تعديل ديسمبر 8, 2018 بواسطه Emad Sabry

[mdsasa]

شكراً لتواصلك أستاذ / عماد

  أقصد أن الكود يغير ألون الخلايا المحددة ، ثم يرجع ألوان الخلايا الأصلية

 : في الصورة الأولي 

في الصف الرابع ، تتغير لألوان أنا محددها (B) (C) (I) الخلايا بالأعمدة 

 : في الصورة الثانية والثالثة

في الصف الرابع ، تتغير للون الأبيض (B) (C) (I) الخلايا بالأعمدة 

المفترض ما تتحول للّون الأبيض تظل مثل ماهي بلونها الأصلي عند فتح الملف 

أرسلت صور بالمرفقات للإيضاح

وشكراً لحضرتك مرة ثانية ع تواصلك وجهدك ما قصرت فى شيئ

 

Screenshots.rar

تم تعديل ديسمبر 8, 2018 بواسطه mdsasa

[Emad Sabry]

أنت عاوز نفس الالوان اللى فى كود ا/شوقى 

استخدم نفس الكود بس اعكس الالوان علشان يكون الكود بالشكل دا 

Sub MM()
For G = 4 To 10
If Cells(G, 15) < 30 Then
If Cells(G, 9).Value > Range("G1").Value Then
Cells(G, 2).Interior.ColorIndex = xlNone
Cells(G, 3).Interior.ColorIndex = xlNone
Cells(G, 9).Interior.ColorIndex = xlNone
MsgBox ("ÇáãæÙÝ : " & " " & Cells(G, 2) & " " & "¡ íäÊåí ÇáÅÔÊÑÇß ÈÊÇÑíÎ : " & " " & Cells(G, 9) & " " & "¡ æÈÇÞí ãä ÇáÃíÇã : " & Cells(G, 15) & " " & "íæã ")
Cells(G, 2).Interior.ColorIndex = 40
Cells(G, 3).Interior.ColorIndex = 42
Cells(G, 9).Interior.ColorIndex = 40
End If
End If

Next
End Sub

 

[mdsasa]

نفس المشكلة أ / عماد

  الصورة الأولي : الألوان بها هي الأساسية

يعني لو الكود شغال صح بترجع الألون لوضعها الطبيعي

  الصورة الثانية : هي التي بها المشكلة

الألوان إتغيرت بالفعل ولكن ثبتت ولم ترجع للألون الأصلية الموجودة بالصورة الأولي

معلش تعبتك معي

[mdsasa]

😔😔

[Emad Sabry]

استخدم الكود التالى 

قبل الاستخدام روح ل page layout  ومن theme تختار colors ثم customize color وعند accent 2 اختار اللون الاصفر وعند accent 3 اختار اللون الارجوانى 

 

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

ملحوظة انت عدل فى النسب المئوية زى ما انت عاوز لحد ما يكون شبه القديم .. مفيش كود هيخليلك الالوان زى ما هى لانك دامج لونين فى بعض دا اولا ثانيا لانك بتمسح الالوان دى فى الاول 

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

Sub Emad()
For G = 4 To 10
If Cells(G, 15) < 30 Then
If Cells(G, 9).Value > Range("G1").Value Then
Cells(G, 2).Interior.Pattern = xlPatternNone
Cells(G, 3).Interior.Pattern = xlPatternNone
Cells(G, 9).Interior.Pattern = xlPatternNone
MsgBox ("ÇáãæÙÝ : " & " " & Cells(G, 2) & " " & "¡ íäÊåí ÇáÅÔÊÑÇß ÈÊÇÑíÎ : " & " " & Cells(G, 9) & " " & "¡ æÈÇÞí ãä ÇáÃíÇã : " & Cells(G, 15) & " " & "íæã ")
 With Range(Cells(G, 2), Cells(G, 3)).Interior
    .Pattern = xlPatternRectangularGradient
    .Gradient.RectangleLeft = 0.01
    .Gradient.RectangleRight = 0.04
    .Gradient.RectangleTop = 0.02
    .Gradient.RectangleBottom = 0.6
    .Gradient.ColorStops.Clear
End With
With Range(Cells(G, 2), Cells(G, 3)).Interior.Gradient.ColorStops.Add(0)
    .ThemeColor = xlThemeColorAccent2
   End With
With Range(Cells(G, 2), Cells(G, 3)).Interior.Gradient.ColorStops.Add(1)
    .ThemeColor = xlThemeColorAccent3
       End With
 With Cells(G, 9).Interior
    .Pattern = xlPatternRectangularGradient
    .Gradient.RectangleLeft = 0.01
    .Gradient.RectangleRight = 0.04
    .Gradient.RectangleTop = 0.02
    .Gradient.RectangleBottom = 0.6
    .Gradient.ColorStops.Clear
End With
With Cells(G, 9).Interior.Gradient.ColorStops.Add(0)
    .ThemeColor = xlThemeColorAccent3
   End With
With Cells(G, 9).Interior.Gradient.ColorStops.Add(1)
    .ThemeColor = xlThemeColorAccent2
       End With

End If
End If
Next
End Sub

 

Emad.xlsm

تم تعديل ديسمبر 9, 2018 بواسطه Emad Sabry

[mdsasa]

أستاذ / عماد .. متشكر جداً جداً لحضرتك

وشكراً لتعبك وجهدك وعدم تقصيرك في إعطاء المعلومة كاملة

ولك مني جزيل الشكر والتقدير

تم تعديل ديسمبر 10, 2018 بواسطه mdsasa