اذهب الي المحتوي
أوفيسنا

عملاق الدوائر الحمراء:: ابو خالد طلب بسيط لو سمحت


الردود الموصى بها

استاذى الفاضل ابوخالد

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

لك كل اعتزازى وتقديرى واحترامى قبل كل شئ

وبعد

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

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

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

مرفق ملف مختصر للتوضيح ستجد المشكلة من اول صف رقم 327

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

______test.rar

رابط هذا التعليق
شارك

السلام عليكم

Sub Circles1()
Dim c As Range
Dim MyRng As Range
Set MyRng = Range("e8:e1000")
For Each c In MyRng
    If c(1, -2).Value = 0 Then GoTo 1
    If c.Value < Cells(7, 5) Or c.Value = "غ" Or c.Value = "غـ" Then
        Set v = ActiveSheet.Shapes.AddShape(msoShapeOval, c.Left, c.Top, c.Width, c.Height)
        v.Fill.Visible = msoFalse
        v.Line.ForeColor.SchemeColor = 10
        v.Line.Weight = 1.25
    End If
1 Next
End Sub

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

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

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

تلميذك استيكا

رابط هذا التعليق
شارك

عوداً حميداً أستاذي الفاضل خبور خير

لكم سعدت لرؤية ردك في هذا الموضوع

تلميذ مغمور يعشق أستاذه المشهور.........

عاشق الإكسيل

رابط هذا التعليق
شارك

ياريت استاذنا الفاضل والجليل خبور خير

يطمئنا على صحته فجميع أعضاء المنتدى في اشتياق شديد له وفي قمة الحرص على السؤال عن صحته وأحواله

أضم صوتي لصوت الأخ زياد

بالفعل كلنا في اشتياق لهذا العملاق الذي يهز أركان هذا المنتدى كلما غدا أو راح عليه

عاشق الإكسيل

رابط هذا التعليق
شارك

الاخ الفاضل خبور

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

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

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

يعمل ولكن وجدت بعض الملاحظات وهى

1- انه يتخطى بعض الخلايا دون رسم الدوائر

2- عند اضافة ارقام جلوس اخرى لا يتم رسم الدوائر عليها

لم استطع ارفاق الملف لانة به ارتباط بملفات اخرى ولكن ارفقت صور توضح الملاحظات

ارجوا الافادة

_____.bmp

تم تعديل بواسطه safwatscc
رابط هذا التعليق
شارك

عفوا للمداخلة الكود جميل ولكن لى سؤلان

الاول يوجد فى الخليو e10 العدد 35 ولا يوضع حولها دائرة

الثانى هل الكود يعمل مع دالة ولا ارى مكانها واذا كان الكود يعمل مع دالة فاين مكانها

رابط هذا التعليق
شارك

السلام عليكم

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

نعم الكود مبرمج مع الخليةE7 بحيث لو كانت اي خلية بالمدى من E8 الى E1000 يقوم بوضع الدائرة

مع الشكر

ابو خالد

رابط هذا التعليق
شارك

السلام عليكم

نعم الكود مبرمج مع الخليةE7 بحيث لو كانت اي خلية بالمدى من E8 الى E1000 يقوم بوضع الدائرة

===========

الرد اعلاه هو جواب استفسارك ادناه

وايضا بقى لى سؤال المشاركة الاولى هل يعمل الكود مع دالة ام لا واين مكانها

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

سؤلا اخران ماذا تعنى ب (1, -2) و Cells(7, 5)

الجزء الاول تحديد العمود الثاني وهو رقم الجلوس ليتم المقارنة عليه اذا كان صفر لايرسم دائرة حمراء

الجزء الثاني هو العمود الخامس الخلية رقم7 يعني زي ماتكتب E7

ان شاء الله وضحت الصورة

مع الشكر

ابو خالد

رابط هذا التعليق
شارك

وضحت الصورة بارك الله فيك ورواك من زمزم

اعزرنى لكثرة الاسئلة فانا رايت الموضوع متاخر جدا وكنت فى حاجة اليه

واذا كان وقتك يسمح ( خد السؤال ده كمان ) ان امكن

هلى يمكن عمل الدوائر هذه على اكثر من عمود وما هى الطريقة

رابط هذا التعليق
شارك

وضحت الصورة بارك الله فيك ورواك من زمزم

اعزرنى لكثرة الاسئلة فانا رايت الموضوع متاخر جدا وكنت فى حاجة اليه

واذا كان وقتك يسمح ( خد السؤال ده كمان ) ان امكن

هلى يمكن عمل الدوائر هذه على اكثر من عمود وما هى الطريقة

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

نعم يمكن بتعديل بسيط في المدى فنحن في مثالنا عملنا الدوائر على العمود D وكان الكود

Set MyRng = Range("e10:e1000")
وليعمل على اكثر من عمود مثلا من E8 الى J1000 يكون الكود
Set MyRng = Range("e10:J1000")

مع الشكر

ابو خالد

رابط هذا التعليق
شارك

[font="Comic Sans MS]الأخ العزيز و المحترم : خـــبور : أهلاً بك وسهلاً ... عوداً محموداً ومباركاً إن شاء الله

حقـــــاً ..... (( كنتم خير أمةٍ أُخرجت للناس .... ))

رابط هذا التعليق
شارك

وليعمل على اكثر من عمود مثلا من E8 الى J1000 يكون الكود

طبقناها وتمام وزى الفل بس هناك مشكلة 0 اريد تطبيقها على اعمدة ليست متتالية

قمثلا اريد تطبيقها على e و h و k وهكذا وكل عمود منهم له نهاية صغرى مختلفة عن العمود الاخر 0 فهل يوجد حلول

رابط هذا التعليق
شارك

الاخ والاستاذ : ابو خالد

بارك الله فيك

الكود يعمل بشكل سليم جدا ولكن

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

يعمل ولكن وجدت بعض الملاحظات وهى

1- انه يتخطى بعض الخلايا دون رسم الدوائر

2- عند اضافة ارقام جلوس اخرى لا يتم رسم الدوائر عليها

لم استطع ارفاق الملف لانة به ارتباط بملفات اخرى ولكن ارفقت صور توضح الملاحظات

الصورة مرفقة فى المشاركة السابقة

____________.rar

رابط هذا التعليق
شارك

السلام عليكم

عملت تطبيق مثل الصورة المرسلة

لمادتين

Range("J8:M1000")
عمود رقم الجلوس هو العمود رقم 2 اما الصف حسب صف الخلية C
Cells(C.Row, 2)

تفضل المرفق

______3.rar

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

السلام عليكم حميعا

أستاذنا الفاضل

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

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

قمثلا اريد تطبيقها على e و h و k وهكذا وكل عمود منهم له نهاية صغرى مختلفة عن العمود الاخر

السلام عليكم

رابط هذا التعليق
شارك

السلام عليكم

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

قمثلا اريد تطبيقها على e و h و k وهكذا وكل عمود منهم له نهاية صغرى مختلفة عن العمود الاخر

Set MyRng = Range("K8:K1000,H8:H1000,E8:E1000")

ودمتم في حفظ الله

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information