كود إضافة وحذف الدوائر إعداد الحاوى

[حسن الحاوى]

كود إضافة وحذف الدوائر

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

حيث يقوم برسم شكل بيضاوى ثم يقوم بجعله بدون تعبئة ثم يقوم بتغيير إسمه إلى oval 1 وجعل سمكه 3 وتلوينه باللون الأحمر

ثم يقوم بقص هذا الشكل البيضاوى ثم يقوم بلصقة داخل الخلايا بشرط أن تكون قيمة هذه الخلايا أقل من الحد الأدنى لكل مادة (عمود الدرجة الفعلية لكل مادة )

ويقوم بعملية اللصق لكل مادة على حدة وذلك لعدد طلاب محدد مسبقاً من الخلية c1

وأثناء كل عملية لصق يقوم بها يتم إضافة العدد 1 إلى قيمة الخلية a1 . وهذا مفيد فى معرفة عدد الأشكال البيضاوية التى سيتم حذفها بكود الحذف

مع قيام كل صاحب شيت بتحديد عرض العمود الذى سيرسم به الدوائر واستبداله بالرقم 54

,وتحديد أرتفاع الصفوف المتقاطعة مع العمود السابق واستبداله بالرقم 50

إضافة وحذف الدوائر-حسن الحاوى .rar

[مجدى يونس]

كود جميل وتشكر عليه

[فضل حسين]

_{الاستاذ الفاضل / حسن الحاوى}

_{عمل رائع وخطير وعمل مثمن وفكرة كود جميلة ومفيدة وجديرة بكل الاحترام والتقدير . جزاك الله كل خير وبارك الله فيك ويضاف هذا العمل لميزان حسناتك اللهم امين .}

_{ولكن لى اكثر من ملحوظة ارجو اخذها فى الاعتبار والرد عليها}

_{1 - الملحوظة الاولى ان عند الضغط على زر اضافة الدوائر للمرة الاولى باضافة الدوائر وفى مثالنا (22 دائرة ) وعند الضغط مرة ثانية على نفس الزر اضافة الدوائر يقوم باضافة رقم 22 على الرقم القديم وهو 22 اى يعطى رسالة بعدد 44 دائرة وهذا بالطبع غير صحيح .}

_{المطلوب عند الضغط للمرة الاولى على الزر اضافة دوائر لايجوز الضغط عليه مره ثانية الا بعد الضغط على زر حذف الدوائر لحل المشكلة السابقة . واقتراحى جعل الزر}

_{اضافة الدوائر غير فعال بعد الضغط علية المرة الاولى وجعل الزر حذف الدوائر هو الفعال والعكس فى حالة الضغط على زر حذف الدوائر .}

_{2-بالنسبة لارتفاع الصف وعرض العمود غير مطابق لعرض ولاارتفاع الدائرة فى الملف}

_{3- اريد من سيادتك شرح الارقام الموجودة فى هذا الامر}

_{ActiveSheet.Shapes.AddShape(msoShapeOval, -7354.5, 1.5, 54#, 50#).Select}

_وشكرا

[دغيدى]

Rectangle65_Click

أخى الفاضل / يمكن إضافة السطر السابق بعد السطر الأول

Sub Frame3_Click()

Rectangle65_Click

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

تم تعديل مارس 30, 2012 بواسطه دغيدى

[حسن الحاوى]

شكراً للأساتذة / دغيدى

/ مجدى يونس

/ فضل1

على إقتراحاتهم التى كنت منتظرها منكم

وشكراً على عطائكم الذى بلا حدود

[حسن الحاوى]

إلى الأستاذ / فضل 1

الكود _{ActiveSheet.Shapes.AddShape(msoShapeOval, -7354.5, 1.5, 54#, 50#).Select}

وهو يعنى رسم أو إضافة شكل من نوع بيضاوى Oval بإحداثى س -7354.5 وإحداثى ص 1.5 وعرض الشكل البيضاوى 54 وإرتفاعه 50

بما يعنى رسمه فى أقصى يمين ورقة العمل أى الخلية A1

ملحوظة 1 - الإحداثى X و Y يتم إحتسابه من الزاوية العليا اليسرى للشاشة أو ورقة العمل حسب البرنامج المستخدم

2 - الشكل البيضاوى ليس له نصف قطر ولكن له عرض القطر الأفقى وله إرتفاع القطر الرأسى

[عبدالله المجرب]

السلام عليكم

كود جميل ومميز

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

   Sub Frame4_Click()

' كود إضافة الدوائر

'=====================================================

' أمر  لعدم إهتزاز الشاشة أثناء تنفيذ الكود

Application.ScreenUpdating = False

'رسم الشكل البيضاوى - وجعله بدون تعبئة - وتغيير إسمه

' تغيير الإسم ضرورى لكى يكون جميع أسماء الدوائر التى سيتم لصقها بعد ذلك لها نفس الإسم تماما حتى يسهل حذفها جميعاً

  'الرقم 54 يمثل عرض الشكل البيضاوى والذى يجب أن يكون نفس عرض العمود الذى يرسم به الدوائر

  'الرقم 50 يمثل إرتفاع الشكل البيضاوى والذى يجب أن يكون نفس إرتفاع الصفوف داخل العمود الذى يرسم به الدوائر

    ActiveSheet.Shapes.AddShape(msoShapeOval, -7354.5, 1.5, 54#, 50#).Select

    With Selection

  .ShapeRange.Fill.Visible = msoFalse

  .Name = "Oval 1"

  .ShapeRange.Line.Weight = 3

  .ShapeRange.Line.Visible = msoTrue

  .ShapeRange.Line.Style = msoLineSingle

  .ShapeRange.Line.Visible = msoTrue

    End With

'=====================================================

'تحديد الشكل البيضاوى - ثم قصه

    ActiveSheet.Shapes.Range(Array("Oval 1")).Select

    Selection.Cut

'=====================================================

    For r = 24 To 62 Step 6

    If r = 42 Then r = 44

    Cells(11, r).Select

    For I = 1 To [c1]

	    'يمثل عدد الطلاب C1

	    If ActiveCell.Value < Cells(10, r) Then

		    ActiveSheet.Paste

		    [a1] = [a1] + 1

	    End If

    'الأمر التالى يعنى تحديد والتحرك لأسفل أى الصف التالى مع البقاء فى نفس العمود

	 ActiveCell.Offset(1, 0).Select

	 Next I

    Next r

    Application.ScreenUpdating = True

	 MsgBox ("  تم إضافة عدد " & [a1] & " دائرة ")

End Sub

[اشرف أبو عرضية]

كود جميل وفكرة اجمل ومنفذين رائعين

[wafaey]

جهد رائع جدا

[حسن الحاوى]

الله عليك يا أستاذ / عبدالله المجرب

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

شكراً جزيلاً

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

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

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

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

واذا اردنا تغيير اعمده الشكل البيضاوي ماذا نفعل ؟

على سبيل المثال اذا ارنا وضع دوائر على درجة التحريري الاقل من الثلث

[حسن الحاوى]

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

واذا اردنا تغيير اعمده الشكل البيضاوي ماذا نفعل ؟

على سبيل المثال اذا ارنا وضع دوائر على درجة التحريري الاقل من الثلث

التعديل فى المرفقات

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

إضافة وحذف الدوائر-حسن الحاوى الكود المعدل من قبل عبد الله المجرب .rar

[حسن الحاوى]

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

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

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

إضافة وحذف الدوائر-حسن الحاوى الكود المعدل من قبل أ- عبد الله المجرب .rar

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