تلوين نطاق خلايا معينة

[mohmod zedan]

محتاج تغيير في الكود ليعمل  عند تغيير اسماء الالوان في نفس نطاق التلوين

 

 

تلوين.xlsx

[mohmod zedan]

@محمد هشام. ارجو الحل   تلوين الازرق باللون الازرق كلمة وخليه والاحمر والاصفر والاخضر هكذا

تم تعديل ديسمبر 27, 2023 بواسطه mohmod zedan

[محمد هشام.]

صراحة لم استوعب طلبك جيدا لاكن جرب وضع هدا الكود في  module 

Option Explicit
Public Sub ColourChange()
Dim Clé As Range
   For Each Clé In ActiveWorkbook.ActiveSheet.Range("F5:F36")
   Application.ScreenUpdating = False
        If Not IsError(Clé) Then
     With Clé
            .Interior.ColorIndex = xlColorIndexNone: .Font.Color = RGB(0, 0, 0)
     Select Case .Value2
        Case "اخضر", "أخضر"
             .Interior.Color = RGB(0, 204, 0): .Font.Color = RGB(0, 204, 0)
                                
        Case "ازرق", "أزرق"
             .Interior.Color = RGB(0, 0, 255): .Font.Color = RGB(0, 0, 255)
                                                   
        Case "اصفر", "أصفر"
             .Interior.Color = RGB(255, 255, 0): .Font.Color = RGB(255, 255, 0)
                                                     
        Case "احمر", "أحمر"
             .Interior.Color = RGB(255, 0, 0): .Font.Color = RGB(255, 0, 0)
                End Select
            End With
        End If
    Next
    Application.ScreenUpdating = True
End Sub

وفي حدث ورقة شهادات ضع الرمز التالي 

 ' على حسب احتياجاتك
Private Sub Worksheet_Activate()
ColourChange
End Sub

' او 

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("F5:F36")) Is Nothing Then
If Target.Cells.Value = Empty Then Exit Sub
        Aplication.EnableEvents = False
           Call ColourChange
        Application.EnableEvents = True
   On Error GoTo 0
End If
End Sub

 

[mohmod zedan]

@

تلوين.xlsm

[محمد هشام.]

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

تلوين.xlsm

تم تعديل ديسمبر 27, 2023 بواسطه محمد هشام.

[mohmod zedan]

بارك الله فيك استاذ ورئيس قسم @محمد هشام.

[محمد هشام.]

هناك حل  اخر لاثراء الموضوع . في وجهة نظري سوف يغنيك عن اظافة كل لون على حدى داخل الكود خاصة ادا قمت باظافة الوان اخرى للملف 

يكفي وضع اسماء الالوان المستخدمة مثلا في عمود AG  وتلوين خلية العمود المجاور  وليكن مثلا AH باللون المطلوب كما في الصورة اسفله

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

Sub Spinner2_Change()
Dim myRange As Range, cell As Range
'نطاق البيانات
Set myRange = Range("F5:F33")

With Application
  .ScreenUpdating = False
 On Error Resume Next
 With myRange
 .Interior.ColorIndex = xlColorIndexNone: .Font.Color = RGB(0, 0, 0)
 End With
  For Each cell In myRange
    If Not IsError(.Match(cell.Value, Columns("AG"), 0)) Then   ' عمود اسماء الالوان

      ' لون الخلفية
      cell.Interior.Color = Cells(.Match(cell.Value, Columns("AG"), 0), "AH").Interior.Color ' عمود الالوان

      ' لون الخط
      cell.Font.Color = Cells(.Match(cell.Value, Columns("AG"), 0), "AH").Interior.Color

    End If
  Next
  .ScreenUpdating = True
  End With
 On Error GoTo 0
   
End Sub

 

تلوين 3.xlsm

تم تعديل ديسمبر 27, 2023 بواسطه محمد هشام.

[mohmod zedan]

بارك الله فيك وزادك من فضله وعلمه