وضع دوائر حمراء على الأرقام دون الحد الأدنى

[علي المصري]

استخدم الكود في الصورة التالية

Sub Circles1()
On Error Resume Next
Call DeletingShp
Dim ws As Worksheet, C As Range, E As Range, F As Range
Dim MyRng As Range, MyRng2 As Range, MyRng3 As Range, V As Shape
Dim G As Integer, R As Integer, D As Integer
Application.ScreenUpdating = False
Set ws = Sheets("شهادات الرابع")
Dim i As Integer
Dim j As Integer
For i = 2 To 12
For j = 1 To 70 Step 13
Set MyRng = ws.Cells("25" + j, i)
Set MyRng2 = ws.Cells("24" + j, i)
Set MyRng3 = ws.Cells("26" + j, i)

For Each C In MyRng: For Each E In MyRng2: For Each F In MyRng3
    If C.Value < E.Value Then                        
        Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, C.Left + 1, C.Top + 1, C.Width, C.Height - 1)
        V.Fill.Visible = msoFalse
        V.Line.ForeColor.SchemeColor = 10
        V.Line.Weight = 1.9
        V.Shadow.Visible = msoFalse
    ElseIf F.Value = "دون المستوى" Then
        Set V = ActiveSheet.Shapes.AddShape(msoShapeRectangle, C.Left + 2, C.Top + 2, C.Width - 5, C.Height - 5)
        V.Fill.Visible = msoFalse
        V.Line.ForeColor.SchemeColor = 10
        V.Line.Weight = 1.9
        V.Shadow.Visible = msoFalse
    
    End If
 Next: Next
 Next
 Next
 Next
Application.ScreenUpdating = True
End Sub

 

يمكن استخدام السطر التالي لجعل اللون أزرق بدل الأحمر للمربع

V.Line.ForeColor.SchemeColor = 4

 

الكود في المرفق

 

دوائر حمراء-Last.rar

[waledms]

جزاك الله خيراً ..... وزادك من علمه .... 

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

تم تعديل يناير 22, 2018 بواسطه waledms

[waledms]

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

‏‏2018شيت مدرستى - الصف الرابع- -.rar