#1
|
||||
|
||||
![]() كود إضافة وحذف الدوائر وهو مكتوب بطريقة مبسطة ومشروحة داخل الكودحيث يقوم برسم شكل بيضاوى ثم يقوم بجعله بدون تعبئة ثم يقوم بتغيير إسمه إلى oval 1 ثم يقوم بقص هذا الشكل البيضاوى ثم يقوم بلصقة داخل الخلايا بشرط أن تكون قيمة هذه الخلايا أقل من الحد الأدنى لكل مادة (عمود الدرجة الفعلية لكل مادة ) ويقوم بعملية اللصق لكل مادة على حدة وذلك لعدد طلاب محدد مسبقاً من الخلية c1 وأثناء كل عملية لصق يقوم بها يتم إضافة العدد 1 إلى قيمة الخلية a1 . وهذا مفيد فى معرفة عدد الأشكال البيضاوية التى سيتم حذفها بكود الحذف |
#2
|
||||
|
||||
![]()
شكرا بارك الله فيك
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
__________________
قناتى على يوتيوب |
#3
|
||||
|
||||
![]()
هذا تعديل ليناسب جميع أوراق العمل والشيتات
مع قيام كل صاحب شيت بتحديد عرض العمود الذى سيرسم به الدوائر واستبداله بالرقم 54 ,وتحديد أرتفاع الصفوف المتقاطعة مع العمود السابق واستبداله بالرقم 50 |
#4
|
||||
|
||||
![]()
جزاك الله كل خير و زاد عملك من حسناتك
|
#5
|
||||
|
||||
![]()
__________________
يخطئ من يظن أن للذئاب ديناً
|
![]() |
العلامات المرجعية |
الكلمات الدلالية (Tags) |
الدوائر, حذف, إضافة |
|
|