الدوائر الحمراء على الدرجات الراسبة وغائب فقط باستثناء الفراغات

[أبو محمد عباس]

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

الاساتذة الافاضل والاخوة الاعزاء بارك الله في جهودكم واعطاكم الصحة والعافية

الملف المرفق فيه كود للدوائر الحمراء على الدرجات التي اقل من 50 وكذلك غائب

لكنها تظهر حتى على الفراغات ارجو ابداء المساعدة لجعل الكود لايضع الدوائر على الفراغات

وتقبلوا فائق الشكر والتقدير

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

 

 

 

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

السلام عليكم

 

تم اضافة هذا السطر الى الكود

If C.Value = "" Then GoTo 1

وهذا الكود بعد التعديل

Sub Circles1()
Dim C As Range
Dim MyRng As Range, v As Shape
Dim X As Integer, G As Integer, R As Integer, D As Integer
'================================================
Set MyRng = Range("F5:M405") ' نطاق الخلايا الذي تريد اضافة الدوائر فيها
'================================================
X = ActiveWindow.Zoom
Application.ScreenUpdating = False
ActiveWindow.Zoom = 100
For Each C In MyRng
    If C.Value = "" Then GoTo 1
    If (C.Value < 50 Or C.Value = "غائب" Or C.Value = "صفر") Then
        Set v = ActiveSheet.Shapes.AddShape(msoShapeOval, C.Left + 3, C.Top + 3, C.Width - 6, C.Height - 6)
        v.Fill.Visible = msoFalse
        v.Line.ForeColor.SchemeColor = 10
        v.Line.Weight = 1.75
        D = D + 1
    End If
1 Next
ActiveWindow.Zoom = X
Application.ScreenUpdating = True
MsgBox "تم إضافة   " & D & "   دائرة بنجاح", vbMsgBoxRtlReading, "الحمدلله"
End Sub

تحياتي

[أبو محمد عباس]

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

الاستاذ والعالم العلامة عبد الله باقشير جزاك الله خيرا

يعجز لساني عن وصف احترامي وتقديري لشخصكم الكريم

وفقكم الله ورعاكم وزادكم من فضله علما وشرفا

 استاذنا الفاضل لكم مني  فائق الاحترام والتقدير

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

ماشاء الله

حفظك الله ورعاك

ايها العالم العلامه عبد الله

**

وللاخ

أبو محمد عباس   اليوم درجة النجاح عندك اكبر من 50 وغدا كل ماده لها درجة نجاح مختلقه

[أبو محمد عباس]

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

الاستاذ الفاضل والاخ الحبيب محمدي عبد السميع جزاك الله خيرا

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

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

ادام الله سبحانه وتعالى المحبة والاخوة وبارك الله في عملكم وعلمكم

تقبل فائق احترامي وتقديري

[ناصر سعيد]

ممكن نسخه كامله في ملف من الكود الاصلي وبه الاضافه الخاصه بالاستاذ عبد الله لو سمحنم

[أبو محمد عباس]

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

الاخ ناصر سعيد المحترم

اليك الملف بعد اضافة كود العالم والعلامة استاذنا الفاضل عبد الله باقشير حفظه الله وزاده علما وشرفا

تقبل فائق احترامي وتقديري

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

 

 

 

[أبو محمد عباس]

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

الاساتذة الافاضل والاخوة الاعزاء جزاكم الله خيرا

اثناء رفعي الملف الى الاخ ناصر سعيد انتبهت الى وجود الدوائر الحمراء

في ورقة التصفية وحتى بعد تغيير التصفية وعدم وجود بيانات تبقى الدوائر في الخلايا نفسها

هل يمكن تعديل الكود بحيث  لاينقل الدوائر الحمراء الى ورقة التصفية

وتقبلوا دعواتي لكم بالموفقية والنجاح في الدنيا والاخرة

مشكلة الدوائر الحمراء عند التصفية التلقائية.rar

 

 

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

السلام عليكم

 

استخدم كود حذف الدوائر RemoveCircles1

بداية كود التصفية

 

تحياتي

[أبو محمد عباس]

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

الاستاذ الفاضل والعالم العلامة عبد الله باقشير حفظكم الباري عز وجل ورعاكم

انعم الله عليكم بالصحة والعافية وزادكم من فضله خيرا كثيرا

تقبل فائق احترامي وتقديري

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

وهو هل يمكن الغاء الدوائر نهائيا من ورقة التصفية حتى لو كانت موجودة في ورقة  الرصد

اعانكم الله لعمل الخير وجزاكم عنا خيرا

 

الدوائر الحمراء في التصفية التلقائية.rar

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

السلام عليكم

 جزاكم الله خيرا وانعم عليكم بنعيم الدنيا والآخرة

وهو هل يمكن الغاء الدوائر نهائيا من ورقة التصفية حتى لو كانت موجودة في ورقة  الرصد

 

 

يمكنك اضافة السطر التالي في الكود Circles1 (كود اظهار الدوائر)

وهو لتعيين خاصية عدم النقل للدائرة المضافة

v.Placement = xlFreeFloating

الكود بعد اضافة هذا السطر

Sub Circles1()
Dim C As Range
Dim MyRng As Range, v As Shape
Dim X As Integer, G As Integer, R As Integer, D As Integer
'================================================
Set MyRng = Range("F5:M405") ' نطاق الخلايا الذي تريد اضافة الدوائر فيها
'================================================
X = ActiveWindow.Zoom
Application.ScreenUpdating = False
ActiveWindow.Zoom = 100
For Each C In MyRng
    If C.Value = "" Then GoTo 1
    If (C.Value < 50 Or C.Value = "غائب" Or C.Value = "صفر") Then
        Set v = ActiveSheet.Shapes.AddShape(msoShapeOval, C.Left + 3, C.Top + 3, C.Width - 6, C.Height - 6)
        v.Fill.Visible = msoFalse
        v.Line.ForeColor.SchemeColor = 10
        v.Line.Weight = 1.75
        v.Placement = xlFreeFloating
        D = D + 1
    End If
1 Next
ActiveWindow.Zoom = X
Application.ScreenUpdating = True
MsgBox "تم إضافة   " & D & "   دائرة بنجاح", vbMsgBoxRtlReading, "الحمدلله"
End Sub

الآن في التصفية لن تظهر الدوائر

 

تحياتي

[أبو محمد عباس]

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

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

ويزيدكم من فضله علما وخيرا وشرفا كبيرا في الدنيا والاخرة

جعلكم الله عونا للجميع واعانكم لعمل الخير والخيرات

تقبل فائق احترامي وتقديري

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

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

 

جزاكم الله خيرا واثابكم بدعائكم واعطاكم بمثله اضعاف مضاعفة

 

تقبلوا تحياتي وشكري

[ناصر سعيد]

ارجو وضع ملف به المزايا الجديده

وهي ان الكود لايعمل دوائر في حاله عدم وجود اسم الطالب

وكذلك يوجد صف للدرجات المطلوب عمل دوائر في اعمدتها

وهذه الدرجات للمواد تختلف من ماده الى اخرى

وكذلك اعتبار ربع درجة الماده ان كانت اقل يعمل الدائره

جزاكم الله خيرا

[أبو محمد عباس]

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

الاخ العزيز ناصر سعيد جزاك الله خيرا

اليك ملف فيه عمل للدوائر الحمراء للمواد التي تختلف في درجة النجاح

دوائرللدرجة التي اقل من 50  في اعمدة مخصصة  ودوائر للدرجة  التي اقل من 30في اعمدة اخرى

تقبل فائق احترامي وتقديري

 

 

تطبيق الدوائر الحمراء لاكثرمن شرط.rar

 

 

 

[وليد فتحي]

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

 

الاستاذ عبدالله لقد تفضل واضاف الكود التالي

If C.Value = "" Then GoTo 1

لكي لا يضيف دائرة للخلايا الفاضية

طيب انا عندي الشهادات وطبعا كل خلية يوجد بها معادلة جلب الدرجات

وطبعا طالما بها معادلة يبقه مش هيعتبرها فاضية وهيضيف لها دائرة

هل من اضافة اخري لكي لا يضيف الدائرة لهذه الخلية اللي هي مفروض فاضية

( بس هي بالاساس بها معادلة )

 

ولكم جزيل الشكر مقدما

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

 

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

 

الاستاذ عبدالله لقد تفضل واضاف الكود التالي

If C.Value = "" Then GoTo 1

لكي لا يضيف دائرة للخلايا الفاضية

طيب انا عندي الشهادات وطبعا كل خلية يوجد بها معادلة جلب الدرجات

وطبعا طالما بها معادلة يبقه مش هيعتبرها فاضية وهيضيف لها دائرة

هل من اضافة اخري لكي لا يضيف الدائرة لهذه الخلية اللي هي مفروض فاضية

( بس هي بالاساس بها معادلة )

 

ولكم جزيل الشكر مقدما

 

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

 

هذا يعتمد على القيمة التي ترجعها المعادلة

اذا كانت ترجع فراغ استخدم نفس الكود

وان كانت ترجع القيمة صفر غير الفراغ في الكود بالقيمة ضفر

 

تحياتي

[وليد فتحي]

 

 

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

 

الاستاذ عبدالله لقد تفضل واضاف الكود التالي

If C.Value = "" Then GoTo 1

لكي لا يضيف دائرة للخلايا الفاضية

طيب انا عندي الشهادات وطبعا كل خلية يوجد بها معادلة جلب الدرجات

وطبعا طالما بها معادلة يبقه مش هيعتبرها فاضية وهيضيف لها دائرة

هل من اضافة اخري لكي لا يضيف الدائرة لهذه الخلية اللي هي مفروض فاضية

( بس هي بالاساس بها معادلة )

 

ولكم جزيل الشكر مقدما

 

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

 

هذا يعتمد على القيمة التي ترجعها المعادلة

اذا كانت ترجع فراغ استخدم نفس الكود

وان كانت ترجع القيمة صفر غير الفراغ في الكود بالقيمة ضفر

 

تحياتي

 

 

ترجع القيمة لفراغ

ولكن تقوم بعمل دائرة على الخلية الفارغة

[أبو محمد عباس]

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

الاخ العزيز وليد فتحي المحترم

ارفقت ملف وفيه معادلة ترجع القيمة فراغ في العمود o  الاصفر والكود يعمل بصورة ممتازة

كما تفضل عالمنا الجليل عبد الله باقشير حفظه الله وزاده علما وشرفا

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

تقبل فائق احترامي وتقديري

 

تطبيق الدوائر الحمراء.rar

 

 

[وليد فتحي]

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

الاخ العزيز وليد فتحي المحترم

ارفقت ملف وفيه معادلة ترجع القيمة فراغ في العمود o  الاصفر والكود يعمل بصورة ممتازة

كما تفضل عالمنا الجليل عبد الله باقشير حفظه الله وزاده علما وشرفا

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

تقبل فائق احترامي وتقديري

 

تطبيق الدوائر الحمراء.rar

 

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

 

الاخ الفاضل  أبو محمد عباس

 

ارفقت ملف به الشهادات وارجو الاطلاع والافادة منك أو من احد الزملاء الافاضل

 

حيث انك لو فتحت صفحة الشهادات وضغط على زر دوائر آلية

 

سوف يضيف دوار حتي اذا كانت الخانات فاضية

 

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

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

 

سوف يضيف دوار حتي اذا كانت الخانات فاضية

 

هداك الله ليست فاضية فيها قيم صفرية

وانت مخفي قيم الصفر في الشيت

 

تحياتي

[وليد فتحي]

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

 

سوف يضيف دوار حتي اذا كانت الخانات فاضية

 

هداك الله ليست فاضية فيها قيم صفرية

وانت مخفي قيم الصفر في الشيت

 

تحياتي

 

أستاذنا الفاضل والجليل / عبدالله باقشير

جزاك الله كل خير للتوضيح

لقد ظننت أنها فارغة لأنني أعطيت قيمة فارغة للخلية ولم أكن أدرك أن الشيت قيمتة صفر

جزاك الله كل خير ونفع بك وزادك من علمه

[وليد فتحي]

كان لي سؤال أخر استاذ عبدالله

بالملف المرفق فورم شاشة الاغلاق الخاص بك

عند حفظ البرنامج بصيغة Excel Binary WorkBook

علشان اقلل من حجم الملف بيظهر ليه الصورة التالية

أتمني التوضيح وجزاك الله كل خير

تم تعديل نوفمبر 19, 2013 بواسطه وليد فتحي

[وليد فتحي]

انا استخدم اوفس 2010 لاني صممت الشيت من االاول عليه

[وليد فتحي]

الرسالة دي بتطلعلي لما بحفظ الشيت باوفس 2010 بصيغة Excel Binary WorkBook