وضع دوائر حمراء على الأرقام دون الحد الأدنى

[waledms]

السلام عليكم ورحمة الله وبركاته ....

أريد وضع دوائر حمراء فى الشهادات على المواد التى دون المستوى وتتغير مع تغير الشهادات.... 

المرفق

‏‏2017شيت مدرستى - الصف الرابع-.rarFetching info...

[waledms]

لم أجد ما أريد فى المحتوى المشابه

[ابراهيم الحداد]

السلام عليكم ورحمة الله

الكود الاول لعمل الدوائر ويخصص له زر و يتم ربطه به

  Sub Circles1()
Call DeletingShp
Dim ws As Worksheet, C As Range
Dim MyRng As Range, V As Shape
Dim G As Integer, R As Integer, D As Integer
Application.ScreenUpdating = False
Set ws = Sheets("شهادات الرابع")
Set MyRng = ws.Range("B27:L27,B40:L40,B53:L53,B64:L64,B76:L76,B88:L88")
For Each C In MyRng
    If C.Value = "دون المستوى" Then
        Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, C.Left + 1, C.Top + 1, C.Width, C.Height - 1)
        V.Fill.Visible = msoFalse
        V.Line.ForeColor.SchemeColor = 10
        V.Line.Weight = 1.9
    End If
 Next
Application.ScreenUpdating = True
End Sub

اما الكود الثانى مخصص لمسح الدوائر وسيعمل تلقائيا مع الكود الاول

Sub DeletingShp()
    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
      If shp.Type = msoShapeOval Then shp.Delete
    Next shp
End Sub

هذا وبالله التوفيق

 

[waledms]

السلام عليكم ورحمة الله وبركاته......

شكراً جزيلاً  على الإهتمام والمجهود....... لكن الكود لا يمسح الدوائر .... ولو أمكن أن تتغير مواضع الدوائر تلقائياً مع تغير اسماء الطلبة ... وتغير موضع ( دون المستوى)

‏‏2017شيت مدرستى - الصف الرابع-.rar

[ابراهيم الحداد]

السلام عليكم ورحمة الله

استبدل هذا السطر فى الكود الثانى

      If shp.Type = msoShapeOval Then shp.Delete

بهذا السطر

If shp.Type = 1 Then shp.Delete

 

[waledms]

جزاك الله خيرا ..... طلب آخر _ إذا سمحت _ هل يمكن وضع الدائرة على الدرجة - بدلاً من المستوى -  إذا كانت الدرجة أقل من النهاية الصغرى للمادة ... وتتغير الدوائر مع تغير الأسماء تلقائياً 

‏‏2017شيت مدرستى - الصف الرابع-.rar

[علي المصري]

تعديل بسيط على الملف المرفق

 

‏‏2017شيت مدرستى - الصف الرابع-.rar

[علي المصري]

السلام عليكم ورحمة الله وبركاته

تم التعديل كما طلب

الدوائر على درجة الطالب

 

 

دوائر حمراء.rar

تم تعديل يناير 14, 2018 بواسطه علي المصري
اضافة مرفق

[waledms]

السلام عليكم ورحمة الله وبركاته ..... الأستاذ/على 

شكرا على الإهتمام ..... ولكن لوحظ عدم وضع دوائر على بعض درجات الطالب الراسب والتى تقل عن النهاية الصغرى ووضع دائرة على درجة أكبر من النهاية الصغرى....... درجة ناجحة......

‏‏2017شيت مدرستى - الصف الرابع-.rar

[علي المصري]

السلام عليكم ورحمة الله وبركاته

ممكن تعطيني مثال

صور الشهادات التي بها خطأ اخي الكريم

 

استخدم المرفق

‏‏2017شيت مدرستى - الصف الرابع-.rar

[waledms]

السلام عليكم ورحمة الله وبركاته..... 

لاحظت وجود دوائر ثابته دائماً فى الخلايا B52  وكذلك خلايا اللغة العربية جميعها B26 - b39 - b52 وهكذا جميع خلايا اللغة العربية ولا تظهر الدوائر فى باقى المواد/ لو أخذنا مثال الشهادة الأولى الطالب /إبراهيم السيد صبحى يتضح ذلك

‏‏2017شيت مدرستى - الصف الرابع-.rar

[علي المصري]

لان الدرجة كانت ثابتة في كل مرة 32.5 وهي اقل من 50

غير الدرحات في الشيت واستخدم ازرار التنقل ولا الفرق

 

كما يمكنك استبدال السطر

    If C.Value < E.Value  Then

بالسطر

    If C.Value < E.Value Or C.Value = "غ" Then

لكي يتم وضع دائرة في حالة الغياب

الكود صبح بالشكل

 Sub Circles1()
On Error Resume Next
Call DeletingShp
Dim ws As Worksheet, C As Range, E As Range
Dim MyRng As Range, V As Shape

Application.ScreenUpdating = False

Set ws = Sheets("شهادات الرابع")
Dim i As Integer
Dim j As Integer

For i = 2 To 12: For j = 1 To 70 Step 13

Set MyRng = ws.Cells("25" + j, i): Set MyRng2 = ws.Cells("24" + j, i)

For Each C In MyRng: For Each E In MyRng2
    If C.Value < E.Value Or C.Value = "غ" Then
        Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, C.Left - 1, C.Top + 1, C.Width, C.Height - 1)
        V.Fill.Visible = msoFalse
        V.Line.ForeColor.SchemeColor = 10
        V.Line.Weight = 1.2
        V.Shadow.Visible = msoFalse
    End If
 Next: Next
 Next
 Next
 
Application.ScreenUpdating = True
End Sub

 

 

‏‏2017شيت مدرستى - الصف الرابع 44-44-.rar

تم تعديل يناير 14, 2018 بواسطه علي المصري
تعديل المرفق

[علي المصري]

-

لاحظ درجات اللغة العربية كلها متشابهه

[waledms]

السلام عليكم ورحمة الله وبركاته........ جزاك الله خيراً أخى الكريم على إهتمامك..... 

هناك ملاحظة عند إختيار شهادة للطالبة أحمد حسين عبد الله بحيث تعرض أول شهادة فى الشهادات ألاحظ وضع دوائر على درجات ناجحة ..... وعند عرض الشهادات بحيث تكون الشهاده لنفس الطالب أحمد حسين رقم أربعه تتغير موضع الدوائر ..... كما فى المرفق

‏‏2017شيت مدرستى - الصف الرابع 44-44-.rar

أى أن الشهادة فى ترتيبها الطبيعى تكون الدوائر مضبوطة وإذا إخترتها من قائمة الأسماء تتغير الدوائر ولا تكون مضبوطه

[علي المصري]

تم التعديل

 

‏‏2017شيت مدرستى - الصف الرابع 44-44-.rar

[waledms]

السلام عليكم ورحمة الله وبركاته ....... جزاك الله خيراً أخى الكريم .... لو أمكن شرح بسيط للكود لكى أتمكن من إستخدامه فى شيتات صفوف أخرى مثل الصف الخامس والسادس وغيرهم....

[علي المصري]

الشرح في الصورة

بالتوفيق ان شاء الله

 

تتكرر بعد 13 صف ممكن تحتلف على حسب عدد الصفوف من أول شهادة إلى الثانية

[waledms]

جزاك الله خيرا ...... هناك ملحوظة يعض الدوائر تظل ثابته فى مكانها ولا تختفى إلا بعد تشعيل الكود من الداخل ( Run ) كما فى المرفق

[علي المصري]

لازم تربط الكود مع كل زر تستخدمه لاظهار الشهادات

القائمة المنسدلة

وزر التبديل

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

 

[waledms]

الله ينور عليك ...... وجزاك الله خيراً .... وزادك من علمه...... وتحية خاصة من أهل المنوفية إلى أهلنا بأسيوط

[waledms]

السلام عليكم ورحمة الله وبركاته.... أخى الكريم / الأستاذ على ...من المعروف بأن الطالب الذى لم يحصل على 30% من درجة إمتحان آخر العام يكون راسب ( دون المستوى ) حتى ولوكان مجموعه النهائى فى الماده أكبر من النصف فى المجموع الكلى للماده ( مثال مادة العلوم مثلاً من 60درجة إذا حصل الطالب على 40 من 60 ولم يحصل على 18 درجة فى إختبار آخر العام يكون راسب ) ..... ولكن لايتم وضع دائرة على الدرجة لآنها أكبر من النصف...

السؤال.... هل يمكن تعيديل فى الكود بحيث ينظر إلى الدرجة إذا كانت أكبر من النصف ( النهاية الصفرى ) ولكن فى خانة المستوى ( دون المستوى ) يتم وضع مربع على الدرجة .... لتدل على أن الطالب لم يحصل على 30% من درجة آخر العام..... 

معذرة لكثرة الأسئلة... والإطاله.... جزاك الله خيراً 

[علي المصري]

استخدم الكود التالي بعد التعديل

Sub Circles1()
On Error Resume Next
Call DeletingShp
Dim ws As Worksheet, C As Range, E As Range, F As Range
Dim MyRng As Range, MyRng2 As Range, MyRng3 As Range, V As Shape
Dim G As Integer, R As Integer, D As Integer
Application.ScreenUpdating = False
Set ws = Sheets("شهادات الرابع")
Dim i As Integer
Dim j As Integer
For i = 2 To 12
For j = 1 To 70 Step 13
Set MyRng = ws.Cells("25" + j, i)
Set MyRng2 = ws.Cells("24" + j, i)
Set MyRng3 = ws.Cells("26" + j, i)

For Each C In MyRng: For Each E In MyRng2: For Each F In MyRng3
    If C.Value < E.Value Or F.Value = "دون المستوى" Then
        Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, C.Left + 1, C.Top + 1, C.Width, C.Height - 1)
        V.Fill.Visible = msoFalse
        V.Line.ForeColor.SchemeColor = 10
        V.Line.Weight = 1.9
        V.Shadow.Visible = msoFalse
    End If
 Next: Next
 Next
 Next
 Next
Application.ScreenUpdating = True
End Sub

 

[waledms]

السلام عليكم ورحمة الله وبركاته.....

عند التطبيق تظهر الرسالة المرفقة....

[waledms]

السلام عليكم ورحمة الله وبركاته.....قمت بإضافة الجزأ الأول من الكودالقديم والحمد لله إشتغل الكود بصوره ممتازه 

Sub DeletingShp()
    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
     If shp.Type = 1 Then shp.Delete
    Next shp
End Sub

ولكن هل يمكن وضع مربع بدل الدائرة على الدرجة الأكبر من النهاية الصغرى ولكنها دون المستوى لعدم حصولها على 3% من درجةإختبار آخر العام

‏‏2017شيت مدرستى - الصف الرابع 44-44-.rar

تم تعديل يناير 21, 2018 بواسطه waledms

[علي المصري]

اكيد احضرتك حذفت الكود التالي

Sub DeletingShp()
    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
     If shp.Type = 1 Then shp.Delete
    Next shp
End Sub