مطلوب كود تلوين شكل تلقائى فى الخلية بناءا على قيمة داخل الخلية

[صفوت جابر]

مطلوب كود تلوين شكل تلقائى فى الخلية بناءا على قيمة داخل الخلية :

الرقم 1 يكون لون الشكل أحمر والرقم لونه أحمر

الرقم 2 يكون لون الشكل أصفر والرقم لونه اصفر 

الرقم 3 يكون لون الشكل اخضر والرقم لونه اخضر

الرقم 4 يكون لون الشكل ازرق والرقم لونه ازرق 

كود لتلوين شكل تلقائى.xlsx

[صفوت جابر]

تعديل على الملف المطلوب

تعديل .xlsx

[lionheart]

Use the oval shapes from Insert tab > Illustrations > Shapes > Oval. Then use this code

Don't forget to change the range to suit your range

Sub Test()
    Dim x, c As Range, r As Long, y As Long, g As Long, b As Long
    Application.ScreenUpdating = False
        r = RGB(255, 0, 0): y = RGB(255, 255, 0)
        g = RGB(0, 176, 80): b = RGB(0, 112, 192)
        For Each c In Range("C8:F11")
            Set x = FindImage(c)
            If Not x Is Nothing Then
                If c.Value = 1 Then
                    c.Font.Color = r: x.Fill.ForeColor.RGB = r
                ElseIf c.Value = 2 Then
                    c.Font.Color = y: x.Fill.ForeColor.RGB = y
                ElseIf c.Value = 3 Then
                    c.Font.Color = g: x.Fill.ForeColor.RGB = g
                ElseIf c.Value = 4 Then
                    c.Font.Color = b: x.Fill.ForeColor.RGB = b
                End If
            End If
            Set x = Nothing
        Next c
    Application.ScreenUpdating = True
End Sub

Function FindImage(CellToCheck As Range) As Shape
    Dim wShape As Shape, addr
    addr = CellToCheck.Address
    For Each wShape In CellToCheck.Parent.Shapes
        If wShape.TopLeftCell.Address = addr Then Set FindImage = wShape: Exit Function
    Next wShape
End Function

 

[صفوت جابر]

لو امكن حضرتك تنزل الكود ويكون مفعل على ملف العمل المرفق ، أكون شاكر لحضرتك ، وطريقة تشغيل الكود لو سمحت .

[lionheart]

You have to delete the shapes in your file and insert Oval shapes as I shown you

Then press Alt+ F11 to login VBE editor and from Insert menu select Module then copy and paste the code I posted

Back to the worksheet and press Alt + F8 and select the macro name and finally click Run

[صفوت جابر]

شكرا جزيلا لحضرتك ، انا نفذت اللى حضرتك قلت عليه واشتغل الكود . طلب بس بسيط ممكن بعد كتابة الرقم يضاف الشكل التلقائي باللون بطريقة تلقائية " كما فى إضافة الدوائر الحمراء تلقائيا فى شهادة الطالب الراسب " وشكرا جزيلا لسعة صدر حضرتك .

[lionheart]

I think this is a different request

Your request from the beginning was how to affect on existing shapes

[صفوت جابر]

جزاك الله عنا خيرا ونفعنا بعلمك شكرا جزيلا لحضرتك .

تم تعديل يناير 25, 2022 بواسطه صفوت جابر