دائرة حمراء

[خالد فتحى]

الي السادة الافاضل

حاولت عمل دائرة حمراء على الشيت المرفق ولم انجح في اظهارها بشكل سليم

برجاء المساعدة

شيت درجات.rar

[ابراهيم الحداد]

السلام عليكم ورحمة الله

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

الكود الاول لرسم الدوائر

Sub Crl_Shp()
' دوائر مواد الرسوب
Dim C As Range
Dim MyRng As Range
Dim LR As Long, i As Long, j As Long
Application.ScreenUpdating = False
LR = Range("B" & Rows.Count).End(xlUp).Row
i = 10
Do While i <= LR
Set MyRng = Range(Cells(i, 5), Cells(i, 23))
For Each C In MyRng
If C.Value < Cells(9, C.Column).Value Or C.Value = "غ" Or C.Value = "" Then
Set x = ActiveSheet.Shapes.AddShape(msoShapeOval, C.Left, C.Top, C.Width, C.Height)
x.Fill.Visible = msoFalse
x.Line.ForeColor.SchemeColor = 10
x.Line.Weight = 1.75
End If
Next
i = i + 1
Loop
Application.ScreenUpdating = True
End Sub

الكود الثانى لمسح الدوائر عند اللزوم

Sub RemovShp()
   ' مسح الدوائر
Dim Shp As Shape
For Each Shp In ActiveSheet.Shapes
If Shp.AutoShapeType = msoShapeOval Then Shp.Delete
Next Shp
End Sub

 

[Ali Mohamed Ali]

ممتاز استاذ ابراهيم عمل رائع جعله الله فى ميزان حسناتك

[hitech]

9 ساعات مضت, ابراهيم الحداد said:

 

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

[ابراهيم الحداد]

السلام عليكم ورحمة الله

الملف بعد اضافة الاكواد

 

 

شيت درجات.xlsm