يوسف عطا

Private Sub Worksheet_Calculate() Dim DataRange As Range Dim C As Range Dim count As Integer Dim o As Shape On Error GoTo errhandler For Each o In ActiveSheet.Shapes If o.Name Like "InvalidData_*" Then o.Delete Next Set DataRange = Cells.SpecialCells(xlCellTypeAllValidation) count = 0 For Each C In DataRange If Not C.Validation.Value Then Set o = ActiveSheet.Shapes.AddShape(msoShapeOval, C.Left + 1, C.Top + 1, C.Width - 3, C.Height - 3) o.Fill.Visible = msoFalse o.Line.ForeColor.SchemeColor = 10 o.Line.Weight = 2 count = count + 1 o.Name = "InvalidData_" & count End If Next Exit Sub errhandler: End Sub الكود كان يعمل فى ملف آخر نقلته للملف الحالى قمت بتعديل طفيف فى شكل الشهادة أصبح الكود يعمل فى الشهادة السفلى و لا يعمل فى الشهادة العليا ولا الوسطى مرفق شكل الشهادة كصورة مع ملاحظة إن الأسطر اللى تحت الدوائر هيتعملها إخفاء وقت الطباعة

الف شكر استاذنا الفاضل احمد بك

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

الاستاذ الفاضل ابراهيم الحداد بعد التحية الكود الذى أرفقته سيادتكم يعطينى إرور ولا يعمل و مرفق الملف وبه الكود تعديل ابراهيم.xls

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

للرفع رفع الله قدركم الإمتحانات على الابواب و نحتاج التعديل على الكود سريعاً جازاكم الله خير اساتذتنا

السلام عليكم أساتذتنا الأفاضل مرفق كود لأحد الأفاضل الغاليين المتميزين بالمنتدى المحترم الكود يعمل جيداً و المطلوب تعديل بسيط عليه فكرة الكود وضع دائرة فى خلية الدرجة النهائية للمادة إذا كانت أقل من درجة النجاح المطلوب إضافة شرطين فى الكود ليضع دائرة فى نفس الخلية حتى لو كانت بها درجة أعلى من درجة النجاح إذا كانت خلية أخرى فى نفس السطر بها أحد الشرطين التاليين 1. أن تكون بها حرف غ 2. أن تكون بها درجة أقل من 21 ومرفق الملف التجريبى و يحتوى على الكود المرفق 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 = 13 ' صف الدرجات Set MyRng = Range("W14:W1013,AF14:AF1013,AO14:AO1013,BA14:BA1013,BM14:BM1013,BQ14:BQ1013,BU14:BU1013,CF14:CF1013,CO14:CO1013,DA14:DA1013") ' نطاق الخلايا الذي تريد اضافة الدوائر فيها '================================================ X = ActiveWindow.Zoom Application.ScreenUpdating = False ActiveWindow.Zoom = 100 For Each C In MyRng If Cells(C.Row, G) = 0 Then GoTo 1 If C.Value = "" 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.Offset(0, -1).Value < Cells(R, C.Column - 1) Or C.Value = "غ" Or C.Value = "غـ" Or C.Value = "صفر") Then Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, C.Left + 2, C.Top + 2, C.Width - 4, C.Height - 4) V.Fill.Visible = msoFalse V.Line.ForeColor.SchemeColor = 10 V.Line.Weight = 1.5 D = D + 1 End If 1 Next Set MyRng = Range("BV14:BV1013") ' نطاق الخلايا الذي تريد اضافة الدوائر فيها '================================================ For Each C In MyRng If Cells(C.Row, G) = 0 Then GoTo 2 If C.Value = "" Then GoTo 2 If IsNumeric(Cells(R, C.Column)) And Not IsEmpty(Cells(R, C.Column)) And (C.Value < Cells(R, C.Column) Or C.Offset(0, -1).Value < Cells(R, C.Column - 1) Or C.Offset(0, -2).Value < Cells(R, C.Column - 2) Or C.Value = "غ" Or C.Value = "غـ" Or C.Value = "صفر") Then Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, C.Left + 2, C.Top + 2, C.Width - 4, C.Height - 4) V.Fill.Visible = msoFalse V.Line.ForeColor.SchemeColor = 10 V.Line.Weight = 1.5 D = D + 1 End If 2 Next Set MyRng = Range("AX14:AX1013,bj14:bj1013,CX14:CX1013") ' نطاق الخلايا الذي تريد اضافة الدوائر فيها '================================================ For Each C In MyRng If Cells(C.Row, G) = 0 Then GoTo 3 If C.Value = "" Then GoTo 3 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 = "غـ" Or C.Value = "صفر") Then Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, C.Left + 2, C.Top + 2, C.Width - 4, C.Height - 4) V.Fill.Visible = msoFalse V.Line.ForeColor.SchemeColor = 10 V.Line.Weight = 1.5 D = D + 1 End If 3 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 تجربة تعديل كود دوائر.xls

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

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

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

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

الله ينور عليك تابع ونا معاك

السلام عليكم أخوتنا الأعزاء على الرابط التالى ومنذ منتصف سنة 2011 أتحفنا الاستاذ عادل حنفى ( حفظه الله ) ببرنامج ممتاز لتوزيع الملاحظين على اللجان الإمتحانية و مع إستمرار العمل بالبرنامج وبعد 8 سنوات من العمل به بدأنا نطمح لبعض التعديلات عليه و الدعوة مفتوحة لكم جميعاً للإدلاء كل بدلوه لعمل بعض التعديلات أو لنقل أنها تطوير للبرنامج فكرة البرنامج بإختصار المدخلات : اسماء الملاحظين عدد اللجان الإمتحانية ( القاعات ) عدد الفترات الإمتحانية المطلوب عمل توزيع لها فكرة بسيطة عن الأكواد 1. تقوم بالتوزيع 2. تقوم برسم جداول للكشف الذى سيتم طباعته 3. تقوم بتقسيم الملاحظين على مجموعتين لكى يسهل توزيعهم 4. تقوم بإحصاء الإحتياطيين و توزيعهم بعدالة ويمكن لكم الإطلاع على البرنامج فى المرفقات ( برنامج الساقية النهائى ) المطلوب تطويره : 1. أن يقبل البرنامج توزيع بعض الإحتياطيين يدوياً ثم يتولى بنفسه توزيع باقى الإحتياطيين مع توزيع الملاحظين على اللجان 2. إمكانية دخول 3 ملاحظين سوياً فى نفس القاعة 3. تعديل كود التوزيع العشوائى ليكون ليس عشوائى بل يكون على وتيرة أو نظام معين يضمن ألا يدخل أى ملاحظ نفس اللجنة مرتين إطلاقاً إلا لو كان عدد الفترات الإمتحانية أكبر من نصف عدد الملاحظين فى حالة التوزيع الزوجى أو أكبر من تلت عدد الملاحظين فى حالة التوزيع الثلاثى ويمكن على سبيل المثال أن يكون التوزيع كما هو موضع بالصورة عن طريق خاصية الكروسات و الأقطار المتكررة و المتتالية و الصورة مرفقة و الله ولى التوفيق برنامج الساقبة النهائى.rar

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

شاكر لك أفضالك و إهتمامك جارى العمل

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

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

حسناً استاذى الغالى سأعمل على ذلك ولكن هل أقوم بعمل ذلك عن طريق دالة كونكاتينات ؟؟ أم الأفضل فقط بإستخدام علامة & فى معادلة لدمج محتويات خليتين ؟؟

اشكرك جزيل الشكر أستاذ سليم على إهتمامك بالفعل تم إستخدام المعادلات لمعرفة نتيجة الطالب بعد وضع الدرجات فى الملف الأصلى وسوف أرفقه لمعاليكم غداً ولكن الهدف من إستخدام التصفية التلقائية أن تكون صفحة طبع النتيجة هى نفسها صفحة غستخراج النتيجة بدون إستخدام كود الترحيل ل 3 صفحات أخرى حيث النتائج ستكون ثلاثة 1. طالبات ناجحات ومنقولات 2. طالبات راسبات ولهن حق الإعادة بالمدرسة 3. طالبات راسبات وليس لهن حق الإعادة بالمدرسة على كل حال سيكون الأمر أكثر وضوحاً عندما أرسل لمعاليكم الملف تحياتى لمعاليكم سليم بك

مرفق ملف للتوضيح لكل طالب صفين متتاليين بهما بعض الخلايا مدمجة فى الصفين مثل الإسم ورقم الجلوس و النتيجة و الرقم السرى و توجد بعض الخلايا غير مدمجة مثل درجة الدور الأول ودرجة الدور الثانى فى نفس المادة فى عدة مواد المطلوب عندما أختار التصفية التلقائية بناء على نتيجة الطالب فى الخلايا المدمجة رأسياً يظهر السطرين كاملين لكل طالب بدلا من أن يظهر سطر واحد و ربما المرفق يوضح الفكرة أفضل دور2.xls

الف شكر على بك على سعة صدرك هل تقترح أن أضيف عدة أعمدة فى صفحة البيانات الاساسية فى حالة دمج مادتين أو أكثر فى نفس وقت الإمتحان ؟ سأحاول و سأوافيك بالنتيجة

الف شكر على بك جاتزاك الله خير على تعبك ولكن المعادلات لا تعمل فعتد تحميل المرفق و فتحه وجدت لجنة 10 مادة الجبر و الفراغية و الأسماء مظبوطة ولما غيرت رقم اللجنة أو إسم المادة لم يجلب أى بيانات بل وضع لى كلمة ?name#

للرفع يا أخونى الأعزاء للرفع رفع الله قدركم فى الدنبا و الآخرة و ننتظر تفاعلكم ابها الكرام و المطلوب بطريقة أخرى أسهل مطلوب معادلات أو كود لجلب بيانات محددة من شيت لشيت أخر بطريقة القوائم المنسدلة ( 2 من القوائم المنسدلة ) الأولى نختار منها رقم اللجنة الثانية نختار منها المادة أو المواد فيجلب لنا فى الجدول المحدد أسماء جميع الطلاب المقيدين فى اللجنة المذكورة ( القائمة المنسدلة الأولى ) الذين لهم حق إمتحان المادة أو المواد المحددة ( القائمة المنسدلة الثانية ) و دمتم بود

يمكنك البحث فى جوجل عن إستضافة مجانية و ستجد عدة مواقع

دورت عليها على الجهاز ومش لاقيها و هرفع الصورة فى المرفقات مضغوطة لتتمكن من تحميلها اوفسنا.rar