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

هل يوجد معادلة لاضافة دوائر عند تحقق الشرط في اوفيس 2003

محمد الورفلي1

بواسطه محمد الورفلي1
في منتدى الاكسيل Excel

 مشاركة
إذهب إلى أفضل إجابة Solved by عبدالله باقشير,

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

محمد الورفلي1

محمد الورفلي1

قام بنشر
  • الكاتب
قام بنشر (معدل)

شكراً اخي الفاضل / رجب

طيب هل ممكن ايكون الكود يعمل علي خلية متغير بمعنى إن درجات الاعمال في مادة معين في عام مثلاً 2014  الدرجة الكبرى 30 اذاً الطالب الذي تحصل على 14 فتكون عليه دائره وعام اخر مثلاً 2013 تكون درجة الاعمال الكبر 10 إذاً الذي تحصل على  4  درجات فيكون علية دائره  هذا يكون في الكود الثابت ام المتغير يكون عن تغيير طبعاً المستخدم الخلية g15 فاريد الكود يتغير حسب الدرجة الموجودة في لخلية g15  هل هذا الامر يوجد في الاكواد

 

 

post-113971-0-75598100-1400504028_thumb.

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

رجب جاويش

قام بنشر
قام بنشر

السلام عليكم

أخى الفاضل / محمد

تم تنفيذ الدوائر على عمود H  اللغة العربية ( أعمال )

ويقوم بالتنفيذ كما تريد

جرب غير الدرجة الموجودة فى الخلية H10

 ثم جرب الكود

 

دوائر.rar

محمد الورفلي1

محمد الورفلي1

قام بنشر
  • الكاتب
قام بنشر

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

الاخ الفاضل رجب  :: احسنت بارك الله فيك

 

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

رجب جاويش

رجب جاويش

قام بنشر
قام بنشر

أستاذى الحبيب / عبد الله باقشير

جميع أعضاء المنتدى يفتقدون ابداعاتك المميزة

كان الله فى عونك على مشاغل العمل والحياة

ونتمنى من الله أن يمتعنا دائما بأعمالك العظيمة

  • Like 1
ناصر سعيد

ناصر سعيد

قام بنشر
قام بنشر

السلام عليكم

 

الشكر واصل للاخ الحبيب رجب جاويش .......اكرمه الله

واعذروني لشحة عطائي هذه الايام

 

هذا تعديل طفيف ليشمل الاعمدة من 8 الى 28

 

المرفق 2003

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

عند الضغط على زر اضافة لااجد اي دوائر .. لماذا ؟

محمد الورفلي1

محمد الورفلي1

قام بنشر
  • الكاتب
قام بنشر

اخي رجب:: 

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

طلب اخير اريدك ان تُظهر لي مكان اظافة اعمده اخر لشيث الثامن والسابع السادس والخامس  كما تعرف انه اكثر في عدد المواد ولااريد ان اتعبك معى بارك الله فيك

  • أفضل إجابة
عبدالله باقشير

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

قام بنشر
  • أفضل إجابة
قام بنشر

السلام عليكم

 

اخي الحبيب رجب  ........حفظه الله

يمكنك انتقاء الاعمدة التي تريدها باستخدام الدالة Choose

بدلا من استخدام الشروط

'  هنا تحدد الاعمدة المطلوبة
        c = Choose(cc, 8, 9, 12, 13, 16, 17, 20, 21, 25, 27)

الكود كاملا

Sub KH_Dwayr()
Dim X As Integer, i As Integer, c As Integer, cc As Integer
Dim myshp As Shape
'===========================
Del
X = ActiveWindow.Zoom
Application.ScreenUpdating = False
ActiveWindow.Zoom = 100
For i = 11 To Cells(Rows.Count, "B").End(xlUp).Row Step 4
    For cc = 1 To 10
    '  هنا تحدد الاعمدة المطلوبة
        c = Choose(cc, 8, 9, 12, 13, 16, 17, 20, 21, 25, 27)
        With Cells(i, c)
            If Not IsEmpty(.Value) And Val(.Value) < 0.5 * Val(Cells(10, c)) Or .Value = "غ" Then
                Set myshp = ActiveSheet.Shapes.AddShape(msoShapeOval, .Left + 2, .Top + 1, .Width - 2, 4 * .Height - 2)
                With myshp
                    .Fill.Visible = msoFalse
                    .Line.Weight = 2
                    .Line.ForeColor.SchemeColor = 10
                    .Line.Visible = msoTrue
                    .Shadow.Visible = msoFalse
                End With
            End If
        End With
    Next
Next
ActiveWindow.Zoom = X
Application.ScreenUpdating = True
End Sub

شاهد المرفق 2003

 

دوائر.rar

  • Like 1
رجب جاويش

رجب جاويش

قام بنشر
قام بنشر

أستاذى الحبيب / عبد الله باقشير

حفظك الله لنا معلما نتعلم من كنوزه كل يوم

جزاك الله عنا خير الجزاء

تلميذكم / رجب جاويش

  • Like 1
ناصر سعيد

ناصر سعيد

قام بنشر
قام بنشر (معدل)

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

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 = 11       '    صف الدرجات
Set MyRng = Range("l9: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

طباعة1.rar

تم تعديل بواسطه nasersaeed
محمد الورفلي1

محمد الورفلي1

قام بنشر
  • الكاتب
قام بنشر (معدل)

الاخوه الافاضل

لااعرف لم لم تستجب مع عند اضافة ارقام اعمدة  (( عمود 29  و عمود 30 للكود اين الخطاء ملاحظة بالنسبة لدمج الخلايا فا الشيت مرتبط باكثر من ملف وهم علي نفس  الدمج فلا استطيع ان اغير حتي يتوافق معي واقصد بدمج الصفوف

Sub KH_Dwayr()
Dim X As Integer, i As Integer, c As Integer, cc As Integer
Dim myshp As Shape
'===========================
Del
X = ActiveWindow.Zoom
Application.ScreenUpdating = False
ActiveWindow.Zoom = 100
For i = 11 To Cells(Rows.Count, "B").End(xlUp).Row Step 4
    For cc = 1 To 10
    '  هنا تحدد الاعمدة المطلوبة
    c = Choose(cc, 8, 9, 12, 13, 16, 17, 20, 21, 25, 27, 29,30)
        With Cells(i, c)
            If Not IsEmpty(.Value) And Val(.Value) < 0.5 * Val(Cells(10, c)) Or .Value = "غ" Then
                Set myshp = ActiveSheet.Shapes.AddShape(msoShapeOval, .Left + 2, .Top + 1, .Width - 2, 4 * .Height - 2)
                With myshp
                    .Fill.Visible = msoFalse
                    .Line.Weight = 2
                    .Line.ForeColor.SchemeColor = 10
                    .Line.Visible = msoTrue
                    .Shadow.Visible = msoFalse
                End With
            End If
        End With
    Next
Next
ActiveWindow.Zoom = X
Application.ScreenUpdating = True
End Sub
تم تعديل بواسطه محمد الخازمي
  • 3 months later...
محمد الورفلي1

محمد الورفلي1

قام بنشر
  • الكاتب
قام بنشر 
Sub KH_Dwayr()
Dim X As Integer, i As Integer, c As Integer, cc As Integer
Dim myshp As Shape
'===========================
Del
X = ActiveWindow.Zoom
Application.ScreenUpdating = False
ActiveWindow.Zoom = 100
For i = 11 To Cells(Rows.Count, "B").End(xlUp).Row Step 4
    For cc = 1 To 10
    '  هنا تحدد الاعمدة المطلوبة
        c = Choose(cc, 8, 9, 12, 13, 16, 17, 20, 21, 25, 27)
        With Cells(i, c)
            If Not IsEmpty(.Value) And Val(.Value) < 0.5 * Val(Cells(10, c)) Or .Value = "غ" Then
                Set myshp = ActiveSheet.Shapes.AddShape(msoShapeOval, .Left + 2, .Top + 1, .Width - 2, 4 * .Height - 2)
                With myshp
                    .Fill.Visible = msoFalse
                    .Line.Weight = 2
                    .Line.ForeColor.SchemeColor = 10
                    .Line.Visible = msoTrue
                    .Shadow.Visible = msoFalse
                End With
            End If
        End With
    Next
Next
ActiveWindow.Zoom = X
Application.ScreenUpdating = True
End Sub

شاهد المرفق 2003

 

 

 

السلام عليكم

كل عام وانتم طيبون بمناسبة العام الدراسي الجديد

 

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

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

  I accept