كود الدوائر الحمراء :: مطلوب حل مشكلة ربع الدرجة

[safwatscc]

الاخوة الافاضل

كم اسعدتنا دالة الدوائر الحمراء المقدمة من خبراء الاكسل وعمالقة الدوائر

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

وبعد

توجد مشكلة الرسوب بسب ربع الدرجة لا يتم وضع الدائرة عليها

مطلوب فى الملف المرفق

اذا كانت الخلية

c14= اللغة العربية

يرسم دائرة على الخلية c12

d14= انجليزى

يرسم دائرة على الخلية d14

وهكذا لباقى المواد كما فى المرفق

وبارك الله فيكم

___________________.rar

[عبدالله باقشير]

السلام عليكم

في الورقة شهادة واحدة فقط ام عدة شهادات؟؟

اذا كان حسب المرفق

استخدم الكود:

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(C) 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 لصفوف

الشهادات المتبقية حسب شرط معين سنضيفه في احدى خلايا صف الدرجات

================================================

___________________.rar

تم تعديل يونيو 12, 2009 بواسطه خبور خير

[قصي]

عندما اغير الرقم الموحود داخل الخلية اي 8

تاتي باسماء طلاب جدد من اين وانا مش شايف غير صفحة الشهادة

ولاننسى الشكر للاستاذ خبور

[safwatscc]

الاخ الفاضل والاستاذ الغالى : خبور خير

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

[محمدي عبد السميع]

بارك الله لك

تم تعديل يونيو 16, 2009 بواسطه mohammadey1

[قصي]

بع الدرحة لوحده ليس المقياس الدقبق

افرض الطالب كان مجموعه في المادة عالي جدا ومع ذلك كان درجته في الامتحان اقل من ربع الدرجة

تعطيه في الشهاده 70 من 100 وهو حاصل غي اقل من ربع الدرجه

الموضوع عايز معدلة او كود حلو من العمالقة

[safwatscc]

الاخ قصى

قانون الامتحانات يشترط ربع الدرجة

[mhrrd]

بعد عناء يوم كامل وجدت هذا الكود واريد ثضبيطه لثلاث شهادات

لو سمحتم غيروا الرقم في الآي 7

ستجدون اسم جديد منين جه

[hany122003]

السلام عليكم

في الورقة شهادة واحدة فقط ام عدة شهادات؟؟

اذا كان حسب المرفق

استخدم الكود:

<!--c1--><div class='codetop'>كود</div><div class='codemain'><!--ec1-->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<!--c2--></div><!--ec2-->

================================================

اذا كانت عدة شهادات

سنضيف في الكود FOR ---NEXT لصفوف

الشهادات المتبقية حسب شرط معين سنضيفه في احدى خلايا صف الدرجات

================================================