ارجو مساعدة لعمل دائره حمراء

[medo2003_fci]

الملف بالمرفقات

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

اريد ان احسب المجموع لكل طالب ايضا عن طريق ماكرو باستخدام I , J

اريد نسخ صف التقديرات في ملف منفصل و ترتيب الطلاب علي حسب المجوع الخاص بهم

ارجوا مساعدتي ضرووووووووووووري

is.rar

[mrwaelhistory]

- بعمل ماكرو بهذا الكود :

Sub sDrawOval()

If TypeName(Selection) <> "Range" Then Exit Sub

Dim ssRange As Range

Set ssRange = Selection

DrawOvals ssRange, 60, 0.2

End Sub

Function fDrawOval(ByVal fRange As Range, MinDegree As Single, MarginRatio As Single) As String

Application.Volatile

DrawOvals fRange, MinDegree, MarginRatio

fDrawOval = ""

End Function

Function DrawOvals(sRange As Range, MinDegree As Single, OvMargRatio As Single)

Dim cCell As Range

Dim shShape As Shape

Dim OvName As String, OvSheet As String

On Error GoTo DR_OVAL_Err

For Each cCell In sRange

OvName = "oval" + cCell.AddressLocal

OvSheet = cCell.Worksheet.Name

If IsExistShape(OvName, OvSheet) Then

If cCell.Value >= MinDegree Or cCell.Formula = "" Then

cCell.Worksheet.Shapes(OvName).Delete

End If

Else

If cCell.Value < MinDegree And cCell.Formula <> "" Then

MrH = OvMargRatio * cCell.Height

MrW = OvMargRatio * cCell.Width

OvalW = cCell.Width - MrW

OvalH = cCell.Height - MrH

Set shShape = cCell.Worksheet.Shapes.AddShape(msoShapeOval, cCell.Left + MrW / 2, cCell.Top + MrH / 2, OvalW, OvalH)

With shShape

.Name = OvName

.Fill.Transparency = 1#

.Fill.Visible = msoFalse

.Line.ForeColor.RGB = RGB(255, 0, 0)

.Line.Weight = 1.25

End With

End If

End If

Next

Set cCell = Nothing

Exit Function

DR_OVAL_Err:

MsgBox Err & " : " & Error

Err.Clear

Resume Next

End Function

Function IsExistShape(ShapeName As String, SheetName As String) As Boolean

Dim shShape As Shape

IsExistShape = False

For Each shShape In ThisWorkbook.Worksheets(SheetName).Shapes

If shShape.Name = ShapeName Then

IsExistShape = True

Exit Function

End If

Next shShape

End Function

2 -بإضافة تلك الدالة :

=fDrawOval(B2:J20;60;0.2)

حيث 60 الحد الأدنى

0.2 هى نسبة الهامش المتروك بين القطع وحدود الخلية

ويمكن تغيير الرقم " 60 " كيفما شئت حسب الحد الأدنى للخلية ،وتغيير النطاق B2:J20 أيضاً

لاحظ أن : تلك الدالة توضع فى خلية فى هامش الصفحة .