قنديل الصياد

للرفع

تم عمل الصفحة ومنتظرة لاستكمالها برفع النتيجة عليها واليك رابط الصفحة http://abusuliman.eb2a.com/natiga/index.htm

ان شاء الله وتحت امر حضرتك مع تحياتى وتحيات الفريق الاعلامى بمنتديات اوفيسنا

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

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

اخى العزيز راجع هذا الرابط http://www.officena.net/ib/index.php?showtopic=54106&hl= ولو اردت ان نقوم برفع النتيجة لك فلك ذلك مجانا

اخى العزيز .. راجع هذا الرابط وان شاء الله يفيدك http://www.officena.net/ib/index.php?showtopic=49351&hl=

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

قمت بإضافة هذا الكود فى ملف به درجات بعض الطلاب وعمل الكود بامتياز ولما تم نقل الكود الى ملف اخر للطلاب يعمل ايضا بكفاءة ولكن سبب بطئ فى التعامل مع باقى الصفحات وتنفذ باقى الاكواد الموجودة بالملف ولكن بثقل شديد جدا مع العلم اننا لو حذفنا هذا الكود من الملف يرجع الى طبيعته الاولي وتعمل جميع اكواده بكفاءة عالية فما الحل مرفق الكود Function TOPTEN(Mark_Table As Range, Cer_Table As Range, RNK As Integer, True_False As Boolean) Application.ScreenUpdating = False Dim Rw, i, k As Long Dim CON As Integer Dim HOS Dim ARR Dim SS Dim M Dim S TOPTEN = "#N/A" '------------------------------------------------------------------- If True_False = True Then ARR = Array("", "الأول", "الثاني", "الثالث", "الرابع" _ , "الخامس", "السادس", "السابع", "الثامن", "التاسع", "العاشر", "الحادى عشر", "الثانى عشر", "الثالث عشر", "الرايع عشر", "الخامس عشر", "السادس عشر", "السابع عشر", "الثامن عشر", "التاسع عشر", "العشرون", "الواحد والعشرون", "الثانى والعشرون", "الثالث والعشرون", "الرابع والعشرون", "الخامس العشرون", "السادس والعشرون", "السابع العشرون", "الثامن والعشرون", "التاسع والعشرون", "الثلاثون", "الواحد وثلاثون", "الثانى والثلاثون", "الثالث والثلاثون", "الرابع والثلاثون", "الخامس والثلاثون", "السادس والثلاثون", "السابع والثلاثون", "الثامن والثلاثون", "التاسع والثلاثون", "الأربعون", "الواحد وأربعون", "الثانى والأربعون", "الثالث والأربعون", "الرابع والأربعون", "الخامس والأربعون", "السادس والأربعون", "السابع والأربعون", "الثامن والأربعون", "التاسع والأربعون", "الخمسون ") If WorksheetFunction.CountIf(Mark_Table, WorksheetFunction.Large(Mark_Table, RNK)) <> 1 Then For i = 1 To RNK If WorksheetFunction.Large(Mark_Table, RNK) = WorksheetFunction.Large(Mark_Table, i) Then Val1 = Val1 + 1 If Val1 = 2 Then SS = " مكرر": RNK = i - 1: Exit For End If Next i End If 10 TOPTEN = ARR(RNK) & SS Exit Function End If '------------------------------------------------------------------- For Rw = 1 To Mark_Table.Rows.Count If WorksheetFunction.Large(Mark_Table, RNK) = Mark_Table.Cells(Rw, 1) Then CON = WorksheetFunction.CountIf(Mark_Table, WorksheetFunction.Large(Mark_Table, RNK)) If CON = 0 Then TOPTEN = Cer_Table.Cells(Rw, 1).TeCONt Exit Function End If If CON <> 0 Then M = M + 1: S = 0 For k = 1 To RNK If WorksheetFunction.Large(Mark_Table, RNK) = WorksheetFunction.Large(Mark_Table, k) Then S = S + 1 Next k If S = M Then TOPTEN = Cer_Table.Cells(Rw, 1).Value Exit Function End If End If End If Next Rw Application.ScreenUpdating = True End Function

شكرا اخى العزيز تم التجربة والكود يعمل كما اردت شكرا جزيلا ... بارك الله فيك وعليك

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

Sub صورة9_نقر() Application.ScreenUpdating = False sama = MsgBox("سيتم الغاء وحذف البيانات؟هل انت متأكد من اجراء هذه العملية", vbYesNo) If sama = vbYes Then Range("g11:am1000").ClearContents Else MsgBox "!! لم يتم الحذف" End If Sheets("مستويات اول نصف العام").Protect Password:="1900" Application.ScreenUpdating = True End Sub Range("g11:am1000").ClearContents يظهر سطر النطاق بلون أصفر عند تنفيذ الكود بالرغم من استخدام الكود فى صفحات اخرى وتم تنفيذه بدون اى أخطاء فما الخطأ فى الكود فى هذه الصفحة

مرفق ملف ونرجو اضافة كود يعمل على اضافة صفوف تحت اخر صف وهو رقم 16 بنفس التنسيقات وبنفس المعادلات الموجودة فى الصف رقم 16 باى عدد نريد 2131.rar

الاستاذ العزيز / مختار حسين ارفق الملف الذى وجد به الخطا وباذن الله نحاول اصلاحه تحياتي

استاذنا القدير الاستاذ ياسر خليل اليك ملف ومنفذ عليه الكود وكلمة سر الملف (1900) درجات نصف العام.rar

شكرا جزيلا ابوصلاح تم عمل المطلوب بنجاح

مرفق كود للاستاذ القدير عبد الله باقشير (كود الدوائر الحمراء) والكود يعمل بكفاءة بشرط ان تكون صفحة درجات الطالب غير محمية بكلمة مرور برجاء تعديل الكود لكى يعمل والصفحات تحت الحماية 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("j12:j56,n12:n56,aa12:aa56,ar12:ar56") ' نطاق الخلايا الذي تريد اضافة الدوائر فيها '================================================ X = ActiveWindow.Zoom Application.ScreenUpdating = False ActiveWindow.Zoom = 100 For Each C In MyRng If Cells(C.Row, G) = 0 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 = "غـ") 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 = 1.25 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

الاخ الكريم اين هى هذه الملفات

استاذى العزيز : الشهادات لاخر العام فقط رابط تحميل الكنترول ويسع 200 طالب كنترول تجريبي لغات ايضا 2015

شكرا لكم جميعا

رابط به الكنترول لجميع الصفوف الابتدائية نسخة نهائية بعد اضافة بعض التعديلات ويسع 100 طالب لكل صف

درجات نصف العام يتم ترحيلها تلقائيا الى شيت آخر العام

تم زيادة اعداد التلاميذ بالكنترول ليسع 400 طالب فى الصفوف الرابع والخامس و 300 طالب فى الصفوف الاول والثانى والثالث

شكرا جزيلا لكم أساتذتى الاحباء على كلماتكم الجميلة والرائعة ... بارك الله فيكم وعليكم وكل عام وحضراتكم بخير

كنترول المرحلة الابتدائية للدورين معاً للعام الدراسي 2015/2014 مرفق كنترول الصفوف الاول والثانى والثالث فى ملف واحد ومرفق معهم ملف الدرجات الذى يسلم للادارات التعليمية نصف العام واخر العام وايضا مرفق كنترول الصفين الرابع والخامس فى ملف واحد ومرفق معهم ملف درجات نصف العام وكذا درجات اخر العام الذى يسلم للادارات التعليمية اسم المستخدم للكنترول فى جميع الصفوف : الصياد كلمة السر : 1964 كلمة السر لحماية الصفحات : 1900 يمكن زيادة الصفوف بعدد التلاميذ فى اى ملف بعد ادخال كلمة السر (1900) الموجودة لحماية الصفحات رابط تحميل الكنترول على مركز الخليج رابط تحميل الكنترول على مخزن تحميل الملف