اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

كود وضع دوائر حمراء


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

الرجاء المساعدة فى ايجاد كود يضع دوائر حمراء على الدرجة بحيث ينظر الى درجة اخرى بمعنى:-

 

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

 

 

طباعة.rar

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

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

تقبل تحياتى 

 

طباعة.rar

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

أخي الحبيب // هاني أبو ادهم

بارك الله فيك

تفضل ما تريده

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

وبعتذر مرفق خارجي لضعف النت عندي

http://www.gulfup.com/?lmdh0t

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

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

تقبل وافر تحياتى

أخيك وتلميذك 

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

جزك الله خيراً الاخ الفاضل أبو حنين

اظن ان المشكلة عندك في هذا السطر من الكود

R = 10      

فهذا الجزء خاص بتحديد صف الدرجات الصغرى

والذي سيتم وضع الدرجات اقل من الدرجات الموجودة في هذا الصف

وحضرتك واضع الدرجات الصغرى في الصف رقم10

فقم باستبدالها برقم 11

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

Sub اضافة_حذف()
On Error Resume Next
Dim XX As Shape
Set XX = ActiveSheet.Shapes("الدائرة")
With XX.TextFrame.Characters
If .Text = "إضافة الدوائر" Then
Circles1
.Text = "حذف الدوائر"
Else
RemoveCircles1
.Text = "إضافة الدوائر"
End If
End With
On Error GoTo 0
End Sub
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
'================================================
G = 2 ' عمود رقم الجلوس
R = 10 ' صف الدرجات
Set MyRng = Range("o11:dn500") ' نطاق الخلايا الذي تريد اضافة الدوائر فيها
'================================================
X = ActiveWindow.Zoom
Application.ScreenUpdating = False
ActiveWindow.Zoom = 100
For Each c In MyRng
If Cells(c.Row, G) = 0 Or Cells(c.Row, G) = "" Then GoTo 1
If IsNumeric(Cells(R, c.Column)) And Not IsEmpty(Cells(R, c.Column)) And (c.Value < Cells(R, c.Column) Or c.Value = "غ" Or c.Value = "غـ") And c.Value <> "" Then
Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, c.Left + 1, c.Top + 1, c.Width - 2, c.Height - 2)
V.Fill.Visible = msoFalse
V.Line.ForeColor.SchemeColor = 10
V.Line.Weight = 3
d = d + 1
End If
1 Next
ActiveWindow.Zoom = X
Application.ScreenUpdating = True
MsgBox "تم إضافة " & d & " دائرة بنجاح", vbMsgBoxRtlReading, "الحمدلله"
End Sub
Sub RemoveCircles1()
Dim shp As Shape, d As Integer
For Each shp In ActiveSheet.Shapes
If shp.AutoShapeType = msoShapeOval Then shp.Delete: d = d + 1
Next shp
MsgBox "تم حذف " & d & " دائرة بنجاح", vbMsgBoxRtlReading, "الحمدلله"
End Sub



 

لو تكرمتم اريد شرح لكل سطر في الكود جزاكم الله خيرا

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

أخي الحبيب // الاستاذ ناصر

سوف اخبرك باهم اسطر في الكود

G = 2 ' عمود رقم الجلوس

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

بمعنى انك اذا كان عمود رقم الجلوس b فان الرقم هو 2 واذا كان c فيكون 3 وهكذا

R = 10 

اما هذا السطر فقد بينت مراده في المشاركة رقم 11

o11:dn500

هذا السطر خاص بنطاق الذي تريد وضع الدوائر الحمراء فيه

Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, c.Left + 1, c.Top + 1, c.Width - 2, c.Height - 2

وهذا الجزء خاص بضبط حدود الدائرة الحمراء

V.Line.ForeColor.SchemeColor = 10

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

V.Line.Weight = 3

وهذا الجزء خاص بسمك الدائرة فاذا قمت بتغيير الرقم تغير سمك الدائرة حسب ما تريد رقيعة او سميكة.

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

أخي الحبيب // الاستاذ ناصر

سوف اخبرك باهم اسطر في الكود

G = 2 ' عمود رقم الجلوس

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

بمعنى انك اذا كان عمود رقم الجلوس b فان الرقم هو 2 واذا كان c فيكون 3 وهكذا

R = 10 

اما هذا السطر فقد بينت مراده في المشاركة رقم 11

o11:dn500

هذا السطر خاص بنطاق الذي تريد وضع الدوائر الحمراء فيه

Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, c.Left + 1, c.Top + 1, c.Width - 2, c.Height - 2

وهذا الجزء خاص بضبط حدود الدائرة الحمراء

V.Line.ForeColor.SchemeColor = 10

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

V.Line.Weight = 3

وهذا الجزء خاص بسمك الدائرة فاذا قمت بتغيير الرقم تغير سمك الدائرة حسب ما تريد رقيعة او سميكة.

زادكم الله من فضله

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

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