شكرا بارك الله فيك
Sub Frame3_Click()
'
' Frame3_Click Macro
' كود إضافة الدوائر
'================================================= ====
' أمر لعدم إهتزاز الشاشة أثناء تنفيذ الكود
Application.ScreenUpdating = False
'رسم الشكل البيضاوى - وجعله بدون تعبئة - وتغيير إسمه
' تغيير الإسم ضرورى لكى يكون جميع أسماء الدوائر التى سيتم لصقها بعد ذلك لها نفس الإسم تماما حتى يسهل حذفها جميعاً
ActiveSheet.Shapes.AddShape(msoShapeOval, -4232.25, 335.25, 54#, 54#). _
Select
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.Name = "Oval 1"
'================================================= ====
'تحديد الشكل البيضاوى - ثم قصه
ActiveSheet.Shapes.Range(Array("Oval 1")).Select
Selection.Cut
'================================================= ====
'تحديد أول خلية فى مادة اللغة العربية
Range("x11").Select
For I = 1 To [c1] - 1
'يمثل عدد الطلاب C1
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value < [x10] Then
'يمثل الخلية التى تحتوى على الحد الأدنى للنجاح X10
ActiveSheet.Paste
[a1] = [a1] + 1
'يمثل الخلية التى سيتم وضع فيها قيمة تمثل عداد ليعد عدد الدوائر التى سيتم رسمها حتى يسهل حذفها بعد ذلك A1
End If
Next I
'================================================= ====
' تحديد أول خلية فى مادة اللغة الإنجليزية
Range("AD11").Select
'دى 5 هى الخلية الأعلى لأول خلية يراد رسم الدائرة فيها
For I = 1 To [c1] - 1
'العدد 5 يمثل عدد الطلاب
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value < [AD10] Then
ActiveSheet.Paste
[a1] = [a1] + 1
End If
Next I
'================================================= ====
' تحديد أول خلية فى مادة الدراسات
Range("AJ11").Select
'دى 5 هى الخلية الأعلى لأول خلية يراد رسم الدائرة فيها
For I = 1 To [c1] - 1
'العدد 5 يمثل عدد الطلاب
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value < [AJ10] Then
ActiveSheet.Paste
[a1] = [a1] + 1
End If
Next I
'================================================= ====
' تحديد أول خلية فى مادة الرياضيات
Range("AR11").Select
'دى 5 هى الخلية الأعلى لأول خلية يراد رسم الدائرة فيها
For I = 1 To [c1] - 1
'العدد 5 يمثل عدد الطلاب
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value < [AR10] Then
ActiveSheet.Paste
[a1] = [a1] + 1
End If
Next I
'================================================= ====
' تحديد أول خلية فى مادة العلوم
Range("AX11").Select
'دى 5 هى الخلية الأعلى لأول خلية يراد رسم الدائرة فيها
For I = 1 To [c1] - 1
'العدد 5 يمثل عدد الطلاب
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value < [AX10] Then
ActiveSheet.Paste
[a1] = [a1] + 1
End If
Next I
'================================================= ====
'تحديد أول خلية فى مادة التربية الفنية
Range("BD11").Select
'دى 5 هى الخلية الأعلى لأول خلية يراد رسم الدائرة فيها
For I = 1 To [c1] - 1
'العدد 5 يمثل عدد الطلاب
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value < [BD10] Then
ActiveSheet.Paste
[a1] = [a1] + 1
End If
Next I
'================================================= ====
'تحديد أول خلية فى مادة الكمبيوتر
Range("BJ11").Select
'دى 5 هى الخلية الأعلى لأول خلية يراد رسم الدائرة فيها
For I = 1 To [c1] - 1
'العدد 5 يمثل عدد الطلاب
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value < [BJ10] Then
ActiveSheet.Paste
[a1] = [a1] + 1
End If
Next I
'================================================= ====
'تحديد أول خلية فى مادة التربية الدينية
Range("BT11").Select
'دى 5 هى الخلية الأعلى لأول خلية يراد رسم الدائرة فيها
For I = 1 To [c1] - 1
'العدد 5 يمثل عدد الطلاب
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value < [BT10] Then
ActiveSheet.Paste
[a1] = [a1] + 1
End If
Next I
'================================================= ====
Application.ScreenUpdating = True
MsgBox (" تم إضافة عدد " & [a1] & " دائرة ")
End Sub
Sub Rectangle65_Click()
'
' Rectangle65_Click Macro
'كود الحذف
'
Dim c As Integer
Dim A As String
A = "oval 1"
c = [a1]
For m = 1 To c
ActiveSheet.Shapes.Range(Array(A)).Select
Selection.Delete
Next m
MsgBox (" تم حذف عدد " & [a1] & " دائرة ")
[a1] = 0
End Sub
|