EL_Kashef قام بنشر يونيو 28, 2017 قام بنشر يونيو 28, 2017 السلام عليكم ورحمة الله وبركاته بفضل الله تعالى أولا وأخيرا ثم بمساعدة الأعضاء الكرام لهم جزيل الشكر والعرفان قمت بعمل ملف أكسيل لكتابة قوائم الفصول المدرسية 2018 بمناسبة اقتراب العام الدراسى الجديد مع العلم أنى مبتدئ فى الأكسيل وإليكم شرح بعض خصائصه الملف يصلح لفرقة واحدة ولكن يمكنك نسخ الملف أكثر من مرة وتعديل أسماء الفصول فبذلك يصلح لأكثر من فرقة عدد طلاب الفرقة الواحدة 500 عدد الفصول 10 لكل فصل 50 طالب تتم كتابة البيانات الأساسية مرة واحدة فى البداية ويتم توزيعها تلقائيا على كل الفصول بعد كتابة بيانات الطلاب تضغط على ترتيب الأسماء أبجديا فيتم الترتيب كالتالى الاسم بترتيب الحروف الأبجدية طبعا ثم الإناث أولا وبعد ذلك الذكور بعد ذلك تضغط على ترحيل البيانات فيتم الترحيل حسب الفصل الذى اخترته مسبقا عند كتابة البيانات يتم استخراج الإحصائيات تلقائيا كل فصل على حده والإحصاء العام للفرقة كلها أكرر يتم حساب الإحصاء بعد ترحيل البيانات الملف معد للطباعة مسبقا بحيث يكون كل فصل فى ورقة واحدة فقط طبعا بالنسبة للبيانات المطلوبة الاسم - النوع - الديانة - الحالة ( دى البيانات اللى بنكتبها عندنا فى القوائم وكل منطقة بتختلف عن التانية طبعا ) باسورد vb لمن يحب الاطلاع على الأكواد Reem.2018* أرجو ابداء الملاحظات للتعديل فى الملف إن أمكن بمساعدتكم طبعا الملف لا يوجد عليه أى حقوق شخصية أو كلمات سر الا التى كتبتها مسبقا فهذا العمل خالص لوجه الله ليستفيد منه الجميع دعوة صالحة بظهر غيب تكفى الملف فى المرفقات للصفوف الإعدادية وتقبلوا تحياتى الصف الأول الإعدادى.rar الصف الثالث الإعدادى.rar الصف الثانى الإعدادى.rar برنامج قوائم الفصول النهائى.rar
سليم حاصبيا قام بنشر يونيو 29, 2017 قام بنشر يونيو 29, 2017 رائع التعديل الذي وضعته على الكود انا بدوري وضعت لك تعديلاً اخر بواسطة الحلقات التكرارية (يمكن استعمالها جيث انه لا خلايا مدمجة) مرفق الكود (الصف الاعدادي الاول) (بدون حلقات تكرارية) يعتمد على Resize او الكود الثاني ***** حلقات تكرارية مع اقتراح نسخ احدهما الى بقية المصنفات حيث انه اسرع Option Explicit Sub tanslate_data_salim1() Dim My_Sh As Worksheet Dim lr1, i, k, m, col, y As Integer Dim my_rg, cel As Range Application.ScreenUpdating = False Application.Calculation = xlCalculationManual lr1 = Main.Cells(Rows.Count, "c").End(3).Row Set my_rg = Main.Range("c17:g" & lr1) For i = 1 To 10 m = 0 Set My_Sh = Sheets(i & "") My_Sh.Range("d12:g36").ClearContents My_Sh.Range("i12:l36").ClearContents For k = 17 To lr1 Select Case m Case Is < 25 col = m + 12 y = 4 Case Else col = m - 13 y = 9 End Select If Main.Cells(k, "g") = i Then My_Sh.Cells(col, y).Resize(1, 4).Value = Main.Cells(k, 3).Resize(1, 4).Value m = m + 1 End If Next Next Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub Option Explicit Sub tanslate_data_salim() Dim My_Sh As Worksheet Dim lr1, i, k, m, x As Integer Dim my_rg, cel As Range Application.ScreenUpdating = False Application.Calculation = xlCalculationManual lr1 = Main.Cells(Rows.Count, "c").End(3).Row Set my_rg = Main.Range("c17:g" & lr1) For i = 1 To 10 m = 0 Set My_Sh = Sheets(i & "") My_Sh.Range("d12:g36").ClearContents My_Sh.Range("i12:l36").ClearContents For k = 17 To lr1 '======================= Select Case m Case Is < 25 If Main.Cells(k, "g") = i Then For x = 0 To 3 My_Sh.Cells(m + 12, 4).Offset(, x) = Main.Cells(k, 3).Offset(, x) Next m = m + 1 End If Case Else If Main.Cells(k, "g") = i Then For x = 0 To 3 My_Sh.Cells(m - 13, 9).Offset(, x) = Main.Cells(k, 3).Offset(, x) Next m = m + 1 End If End Select Next Next Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub
EL_Kashef قام بنشر يونيو 29, 2017 الكاتب قام بنشر يونيو 29, 2017 السيد سليم شرفنى مرورك وردك الرائع والمشجع والأروع الأكواد التى أعطيتنى إياها والتى لولاها ماكنت أكملت هذا الملف جربت الأكواد وهى بالفعل رائعة سلمت يداك تقبل شكرى وتقديرى 1
سليم حاصبيا قام بنشر يونيو 29, 2017 قام بنشر يونيو 29, 2017 منذ ساعه, EL_Kashef said: السيد سليم شرفنى مرورك وردك الرائع والمشجع والأروع الأكواد التى أعطيتنى إياها والتى لولاها ماكنت أكملت هذا الملف جربت الأكواد وهى بالفعل رائعة سلمت يداك تقبل شكرى وتقديرى كود اخر بواسطة Loop انتبه الى الملاحظات في اسفل الكود بواسطة هذه المعادلات لا تتأثر الخلايا في حال زيادة صفوف او حذف صفوف (قبل الصف 12)من الورقة أو اذا تم حذف اي اسم من لائحة الفصل لا يتأثر الترقيم في كلا العامودين اذا كنت قد فهمت الكود اليك هذا المهمة تنزيل كود اخر بحيث: 1-يعمل على المتغير I بواسطة Loop (من 1 الى 10) * عدد الفصول 2-يعمل على المتغير K بواسطة Loop (من 17 الى اخر صف في الورقة Main) * هذا الخاصية موجودة في الكود المرفق 3- يقوم بترقيم التلاميد بدون معادلات في العامودين I & C في كل ورقة من ورقات الصفوف Option Explicit Sub tanslate_data_salim_loop() Dim My_Sh As Worksheet Dim lr1, i, k, m, col, y As Integer Dim my_rg, cel As Range Application.ScreenUpdating = False Application.Calculation = xlCalculationManual lr1 = Main.Cells(Rows.Count, "c").End(3).Row Set my_rg = Main.Range("c17:g" & lr1) For i = 1 To 10 m = 0 Set My_Sh = Sheets(i & "") My_Sh.Range("d12:g36").ClearContents My_Sh.Range("i12:l36").ClearContents k = 17 Do Until k = lr1 + 1 'يمكنك استعمال هذا السطر ' Do While k <= lr1 'او هذا السطر Select Case m Case Is < 25 col = m + 12 y = 4 Case Else col = m - 13 y = 9 End Select If Main.Cells(k, "g") = i Then My_Sh.Cells(col, y).Resize(1, 4).Value = Main.Cells(k, 3).Resize(1, 4).Value m = m + 1 End If k = k + 1 Loop Next Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ملاحظات ' بالنسبة للمعادلات في صفحات الصفوف 'الافضل كتابة هذه المعادلة في الخلية 'C12: '=IF(D12="","",MAX($C$11:C11)+1) 'ثم اسحب نزولاً 'و هذه المعادلة في الخلية 'I12: '=IF(I12="","",MAX(C:C)+ROWS($A$1:A1)) 'ثم اسحب نزول ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 3
EL_Kashef قام بنشر يونيو 29, 2017 الكاتب قام بنشر يونيو 29, 2017 يعجز لسانى عن الشكر وعن المتابعة المستمرة لملفى المتواضع وقد قمت بإضافة تعديل بسيط على الملف وهو إضافة زر لمسح البيانات جميعها فى صفحة بيانات الطلاب وكذلك اضافة زر لمسح بيانات الطلاب وذلك فى كل فصل على حدة فى المرفقات برنامج قوائم الفصول.rar
EL_Kashef قام بنشر يونيو 29, 2017 الكاتب قام بنشر يونيو 29, 2017 تم إضافة زر للحفظ التلقائى والخروج مباشرة برنامج قوائم الفصول.rar 1
سليم حاصبيا قام بنشر يونيو 29, 2017 قام بنشر يونيو 29, 2017 يجب علي ماكرو المسح في صفجة بيانات الطلا ب ان لا ينفذ الا على هذه الصفخة بالذات لذلك تداركاً للخطأ يجل علينا وضع سطر في الكود If ActiveSheet.Name <> "بيانات الطلاب" Then Exit Sub ليصيح الكود هكذا Sub ClearConstantsOnly() 'كود مسح البيانات و الحفاظ على المعادلات If ActiveSheet.Name <> "بيانات الطلاب" Then Exit Sub prompt = "هل حقا تريد مسح كل البيانات!؟" Command_buttons = vbYesNo + VbMsgBoxRt1Reading Title = "تحذير. انتبه !!!!" project = MsgBox(prompt, Command_buttons, Title) If project = vbYes Then On Error Resume Next Range("c17:g516").SpecialCells(xlCellTypeConstants).ClearContents Range("A1").Select End If End Sub 3
EL_Kashef قام بنشر يونيو 29, 2017 الكاتب قام بنشر يونيو 29, 2017 (معدل) تم تعديل الكود وشكرا على المتابعة المستمرة برنامج قوائم الفصول.rar تم تعديل يونيو 29, 2017 بواسطه EL_Kashef
EL_Kashef قام بنشر يونيو 30, 2017 الكاتب قام بنشر يونيو 30, 2017 تم إضافة تعديل على الملف وهو عمل نسخة احتياطية من الملف وقتما تشاء تضاف بجانب الملف الأصلى مع اضافة تاريخ اليوم الملف فى المرفقات برنامج قوائم الفصول.rar 1
geme114 قام بنشر سبتمبر 10, 2018 قام بنشر سبتمبر 10, 2018 مشكور اخى ولكن اريد زيادة عدد الفصول وعدد الطلاب بالفصول كيف يتم عمل ذلك
Ali Mohamed Ali قام بنشر سبتمبر 10, 2018 قام بنشر سبتمبر 10, 2018 جرب هذا تمت الزيادة برنامج قوائم الفصول.xls 1
geme114 قام بنشر سبتمبر 10, 2018 قام بنشر سبتمبر 10, 2018 (معدل) الف شكر لاهتمام حضرتك جدا وجزاك الله الف خير بس فيه مشكلة بسيطة عند اختيار الفصل من القائمة مبلقيش غير 10 فصول بس ارجو تعديلها ولك جزيل الشكر وقوائم الفصول عند طباعتها غير منضبطة تم تعديل سبتمبر 10, 2018 بواسطه geme114 اضافة
مصطفى محمود مصطفى قام بنشر سبتمبر 10, 2018 قام بنشر سبتمبر 10, 2018 (معدل) منذ ساعه, geme114 said: الف شكر لاهتمام حضرتك جدا وجزاك الله الف خير بس فيه مشكلة بسيطة عند اختيار الفصل من القائمة مبلقيش غير 10 فصول بس ارجو تعديلها ولك جزيل الشكر وقوائم الفصول عند طباعتها غير منضبطة بعد اذن الاستاذ علي جزاه الله خيرا لاحظ التعديل حسب طلبكم تحياتي برنامج قوائم الفصول++.xls تم تعديل سبتمبر 10, 2018 بواسطه مصطفى محمود مصطفى 1
Ali Mohamed Ali قام بنشر سبتمبر 10, 2018 قام بنشر سبتمبر 10, 2018 بارك الله فيك استاذ مصطفى وجزاك الله كل خير وهذا لإثراء الموضوع برنامج قوائم الفصول.xls 1
geme114 قام بنشر سبتمبر 10, 2018 قام بنشر سبتمبر 10, 2018 (معدل) الف شكر لاهتمام حضرتك جدا وجزاك الله الف خير بس مازلت المشكلة فى بيانات الفصول فى القوائم الاسماء التى تضاف تضاف فى جانب واحد فقط وهناك مشكلة اخرى انه عند ترحيل وبعد ذلك تغير الفصل لا يتم الغاء الاسماء من قوائم الفصول تم تعديل سبتمبر 10, 2018 بواسطه geme114 اضافة
Ali Mohamed Ali قام بنشر سبتمبر 10, 2018 قام بنشر سبتمبر 10, 2018 أعتقد ان هذا كل ما تريد واتمنى ان لا تحتاج شيء اخر برنامج قوائم الفصول.xlsm 3
سليم حاصبيا قام بنشر أكتوبر 27, 2019 قام بنشر أكتوبر 27, 2019 تمت الاجابة على هذا العنوان https://www.officena.net/ib/topic/97282-ارجو-المساعدة-فى-فى-ترقيم-هذا-الملف/
الردود الموصى بها