السلام عليكم
في الورقة شهادة واحدة فقط
استخدم الكود:
كود
Sub test2()
Dim MyArray
Dim MyCell As Range
Dim V As Shape
Dim X As Integer
Dim C As Integer
dell ' مسح الدوائر
'================================================
MyArray = Array("اللغة العربية", "انجليزى", "الدراسات", "الرياضيات", "العلوم", "رسم", "المجموع", "دين")
'================================================
X = ActiveWindow.Zoom
Application.ScreenUpdating = False
ActiveWindow.Zoom = 100
For C = 0 To 7
Set MyCell = Cells(12, C + 3)
If MyCell.Offset(2, 0).Value = MyArray© Then
Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, MyCell.Left + 1, MyCell.Top + 1, MyCell.Width - 2, MyCell.Height - 2)
V.Fill.Visible = msoFalse
V.Line.ForeColor.SchemeColor = 10
V.Line.Weight = 1.25
End If
Next
ActiveWindow.Zoom = X
Application.ScreenUpdating = True
MsgBox "تم إضافة الدوائر بنجاح", vbMsgBoxRtlReading, "الحمدلله"
End Sub
================================================
اذا كانت عدة شهادات
سنضيف في الكود FOR ---NEXT لصفوف
الشهادات المتبقية حسب شرط معين سنضيفه في احدى خلايا صف الدرجات
ماسبق للعملاق خبور
ونحن نطلب منه
ان يرفق ملفا بسيطا في حالة عدة شهادات بالورقة 4 شهادات