ناصر سعيد

====================

=================

===============

عمل اللجان المدرسيه الخاصه بالكنترول المدرسي بالمصفوفات لجان كنترول مدرسي.rar Sub Legan_Test() Dim ws As Worksheet Dim sh As Worksheet Dim arr As Variant Dim arrC As Variant Dim temp1 As Variant Dim temp2 As Variant Dim lr As Long Dim i As Long Dim j As Long Dim k As Long Dim p1 As Long Dim p2 As Long Set ws = Sheets("بيانات الطلبة") Set sh = Sheets("كشوف المناداة") lr = ws.Cells(Rows.Count, 5).End(xlUp).Row Application.ScreenUpdating = False sh.Range("C10:F39").ClearContents sh.Range("K10:N39").ClearContents sh.Rows("10:39").Hidden = False arr = ws.Range("A7:V" & lr).Value arrC = Array(2, 5, 15, 16) ReDim temp1(1 To UBound(arr, 1) + 1, 0 To UBound(arrC) + 1) ReDim temp2(1 To UBound(arr, 1) + 1, 0 To UBound(arrC) + 1) For i = 1 To UBound(arr) If arr(i, 18) = sh.Range("E3").Value Then p1 = p1 + 1 For j = 0 To UBound(arrC) temp1(p1, j) = arr(i, arrC(j)) Next j End If If arr(i, 18) = sh.Range("M3").Value Then p2 = p2 + 1 For j = 0 To UBound(arrC) temp2(p2, j) = arr(i, arrC(j)) Next j End If Next i If p1 > 0 Then sh.Range("C10").Resize(p1, UBound(temp1, 2)).Value = temp1 If p2 > 0 Then sh.Range("K10").Resize(p2, UBound(temp2, 2)).Value = temp2 If p1 > 0 Then k = p1 If p2 > 0 And p2 > k Then k = p2 k = k + 10 If k < 39 Then sh.Rows(k & ":39").Hidden = True Application.Visible = True Application.ScreenUpdating = True End Sub

اخي kalll كنت اتمنى ان اساعدك ولكن ادعو الله ان يرزقك باحد الاخوة الذين يستطيعون اجابة طلبك ==================== ====== Sub Legan_Test() Dim ws As Worksheet Dim sh As Worksheet Dim arr As Variant Dim arrC As Variant Dim temp1 As Variant Dim temp2 As Variant Dim lr As Long Dim i As Long Dim j As Long Dim k As Long Dim p1 As Long Dim p2 As Long Set ws = Sheets("بيانات الطلبة") Set sh = Sheets("كشوف المناداة") lr = ws.Cells(Rows.Count, 5).End(xlUp).Row Application.ScreenUpdating = False sh.Range("C10:F39").ClearContents sh.Range("K10:N39").ClearContents sh.Rows("10:39").Hidden = False arr = ws.Range("A7:V" & lr).Value arrC = Array(2, 5, 15, 16) ReDim temp1(1 To UBound(arr, 1) + 1, 0 To UBound(arrC) + 1) ReDim temp2(1 To UBound(arr, 1) + 1, 0 To UBound(arrC) + 1) For i = 1 To UBound(arr) If arr(i, 18) = sh.Range("E3").Value Then p1 = p1 + 1 For j = 0 To UBound(arrC) temp1(p1, j) = arr(i, arrC(j)) Next j End If If arr(i, 18) = sh.Range("M3").Value Then p2 = p2 + 1 For j = 0 To UBound(arrC) temp2(p2, j) = arr(i, arrC(j)) Next j End If Next i If p1 > 0 Then sh.Range("C10").Resize(p1, UBound(temp1, 2)).Value = temp1 If p2 > 0 Then sh.Range("K10").Resize(p2, UBound(temp2, 2)).Value = temp2 If p1 > 0 Then k = p1 If p2 > 0 And p2 > k Then k = p2 k = k + 10 If k < 39 Then sh.Rows(k & ":39").Hidden = True Application.Visible = True Application.ScreenUpdating = True End Sub هذا الحل الخاص بدمج الكودين الخاصين بعمل اللجان واخفاء الصفوف الزياده جزى الله كل من له بصمه في اخراج هذا العمل الى النور ونخص .. الاستاذ خالد الرشيدي والاستاذ ياسر خليل والاستاذ محمد الدسوقي وشخصنا البسيط لجان كنترول مدرسي.rar

تم الحل في هذا الرابط

هذا الكود ياتي بالنواتج ولكننا نريد نريد ان يتم التسطير على البيانات اوتوماتيك وان يكون بالكود بعض التنسيقات مثل حجم الخط واسمه وتوسيطه ربنا ييسر الامور او يتم اخفاء الصفوف الزياده Sub Legan_I() ' فى البداية تم عمل كشاف لتوزيع اللجان فى ورقة بيانات الطلبة ' وتحديد بداية أرقام الجلوس ونهايتها وكذلك بداية أرقام اللجان ونهائيتها ' كخطوة لتهيئة العمل ' <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> ' ' الاعلان عن المتغيرات Dim ws As Worksheet, Sh As Worksheet Set ws = Sheets("كشوف المناداة ") Set Sh = Sheets("بيانات الطلبة") Dim Arr As Variant, Arr1 As Variant, Temp As Variant Dim LR As Long, i As Long, j As Long, p As Long ' تحديد آخر سطر يحتوى على بيانات فى ورقة المصدر والذى يرتبط بعمود الأسماء رقم 5 LR = Sh.Cells(Rows.Count, 5).End(xlUp).Row '------------------------------------ Application.ScreenUpdating = False ' مسح محتوى البيانات المتغير فى صفحة الهدف ws.Range("C10:F39").ClearContents ' تحديد نطاق بيانات العمل فى ورقة المصدر Arr = Sh.Range("A7:V" & LR).Value Arr1 = Array(2, 5, 15, 16) ' تخزين أرقام الأعمدة المطلوب ترحيها فى مصفوفة بهذا الاسم ReDim Temp(1 To UBound(Arr, 1) + 1, 0 To UBound(Arr1) + 1) For i = 1 To UBound(Arr) ' المعيار الذى يتم بناء عليه ترحيل البيانات وهو هنا ' العمود رقم 18 فى ورقة المصدرالذى سحتوى على أرقام اللجان ' ولابد أن يكون مساويا لقيمة رقم اللجنة الموجودة فى ورقة الهدف فى الخلية E3 If Arr(i, 18) = ws.Range("E3").Value Then '--------------------------------------- p = p + 1 For j = 0 To UBound(Arr1) Temp(p, j) = Arr(i, Arr1(j)) Next j End If Next i ' إذا تحقق الشرط السابق فيتم ترحيل البياناتالمخزنة فى المصفوفة إلى ورقة الهدف ابتداء من الخلية C10 If p > 0 Then ws.Range("C10").Resize(p, UBound(Temp, 2)).Value = Temp ' بذلك يكون قد تم ترحيل بيانات أول قائمة فى كشف المناداة ' ولعمل نفس الكود فى القائمة الثانية المجاورة ' قمت بعمل نفس الكود مع تغيرات بسيطة على نطاقات الخلايا الهدف ' ثم تم استدعاء الكود الثانى من خلال الكود الأول فى الخطوة التالية '******************************* Call Legan_II '******************************* ' Application.Visible = True Application.ScreenUpdating = True End Sub '******************************* '******************************* ' الكود الثانى لاستدعاء بيانات القائمة الثانية لكشوف المناداة Sub Legan_II() '=========================================== ' فى البداية تم عمل كشاف لتوزيع اللجان فى ورقة بيانات الطلبة ' وتحديد بداية أرقام الجلوس ونهايتها وكذلك بداية أرقام اللجان ونهائيتها ' كخطوة لتهيئة العمل ' <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> ' ' الاعلان عن المتغيرات Dim ws As Worksheet, Sh As Worksheet Set ws = Sheets("كشوف المناداة ") Set Sh = Sheets("بيانات الطلبة") Dim Arr As Variant, Arr1 As Variant, Temp As Variant Dim LR As Long, i As Long, j As Long, p As Long ' تحديد آخر سطر يحتوى على بيانات فى ورقة المصدر والذى يرتبط بعمود الأسماء رقم 5 LR = Sh.Cells(Rows.Count, 5).End(xlUp).Row '------------------------------------ Application.ScreenUpdating = False ' مسح محتوى البيانات المتغير فى صفحة الهدف ws.Range("K10:N39").ClearContents ' تحديد نطاق بيانات العمل فى ورقة المصدر Arr = Sh.Range("A7:V" & LR).Value Arr1 = Array(2, 5, 15, 16) ' تخزين أرقام الأعمدة المطلوب ترحيها فى مصفوفة بهذا الاسم ReDim Temp(1 To UBound(Arr, 1) + 1, 0 To UBound(Arr1) + 1) For i = 1 To UBound(Arr) ' المعيار الذى يتم بناء عليه ترحيل البيانات وهو هنا ' العمود رقم 18 فى ورقة المصدرالذى سحتوى على أرقام اللجان ' ولابد أن يكون مساويا لقيمة رقم اللجنة الموجودة فى ورقة الهدف فى الخلية E3 If Arr(i, 18) = ws.Range("M3").Value Then '--------------------------------------- p = p + 1 For j = 0 To UBound(Arr1) Temp(p, j) = Arr(i, Arr1(j)) Next j End If Next i ' إذا تحقق الشرط السابق فيتم ترحيل البياناتالمخزنة فى المصفوفة إلى ورقة الهدف ابتداء من الخلية C10 If p > 0 Then ws.Range("K10").Resize(p, UBound(Temp, 2)).Value = Temp ' بذلك يكون قد تم ترحيل بيانات تان قائمة فى كشف المناداة Application.Visible = True Application.ScreenUpdating = True End Sub اخفاء صفوف زائده.rar

اخي صديق المشكله عندك .. جزاك الله خيرا اخي ahmedkamelelsay ربنا يبارك فيك ويارب تكون استفدت

تكوين قوائم فصول المدرسة هذا الملف من ابداع المحترم محمود الشريف .. وهو خاص بتكوين قوائم للفصول المدرسيه .. ولاأروع منه جزاه الله عنا كل خير وبارك له طريقه العمل مع الملف اضغط زر القيم الفريده ليجلب اسماء الفصول مرتبه اختر بعد ذلك الفصل الذي تريد استخراج قائمته من الخليه L1 ======================== تكوين فصول للمحترم محمود الشريف.rar ==== خطوط رائعه يمكن ان تضاف الى الجهاز لتجميل قائمه الفصل ================= خط.rar ========== رابط لخطوط غايه في الجمال والروعه https://up.top4top.net/downloadf-3206k2ma1-rar.html

للرفع

السلام عليكم ورحمة الله هذا كود للمحترم الاستاذ خالد الرشيدي .. وهو اكثر من رائع وقد حاولت اكثر من مره اضافته للملف المرفق ... ولكن شاء الله ان استعين به اول ثم بكم لكي يتوافق مع الملف المطلوب ان يتم ضبط الكود ليتوافق مع الملف جزاكم الله خيرا Sub كشوف_اللجان() '***************************************** '***************************************** Dim Legan As Worksheet, Main As Worksheet Dim Arr As Variant, Arr1 As Variant, Temp As Variant Dim LR As Long, i As Long, j As Long, p As Long Set Legan = Sheets("كشوف اللجان") Set Main = Sheets("بيانات الطلبة") '***************************************** LR = Main.Cells(Rows.Count, 2).End(xlUp).Row Application.ScreenUpdating = False Sheets("كشوف اللجان").Unprotect Password:="1" Legan.Range("C9:F39").ClearContents Legan.Range("J9:M39").ClearContents Arr = Main.Range("A9:W" & LR).Value Arr1 = Array(5, 15, 16) ReDim Temp(1 To UBound(Arr, 1) + 1, 0 To UBound(Arr1) + 1) For i = 1 To UBound(Arr) '========== If Arr(i, 11) = Legan.Range("D4").Value Then '***************************************** p = p + 1 For j = 0 To UBound(Arr1) Temp(p, j) = Arr(i, Arr1(j)) Next j End If Next i Sheets("كشوف اللجان").Unprotect Password:="1", DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFormattingCells:=True, AllowFormattingColumns:=True, _ AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True ActiveSheet.EnableSelection = xlNoRestrictions Application.Visible = True Application.ScreenUpdating = True End Sub ========================== اللجان بطريقه استاذ خالد الرشيدي.rar

ربنا يبارك فيك استاذ شريف

'تسطير الصفوف المحتوية على البيانات x = Range(Range("A1").CurrentRegion.Address).Rows.Count With Range("A3:L" & x) .Borders.LineStyle = 1 End With جمل برمجيه مفيده

جزاك الله كل خير افتح محرر الاكواد لتنال دعوات طيبه اكثر

لم يستقر استاذ محمد الدسوقي على رابط وهذا اخر رابط له ======== روابط التحميل ـ بتاريخ 14 / 10 /2017 ============ الصف الأول http://www.mediafire.com/…/%D8%A7%D9%84%D8%A3%D9%88%D9%84_%… الصف الثانى http://www.mediafire.com/…/%D8%A7%D9%84%D8%AB%D8%A7%D9%86%D… الصف الثالث http://www.mediafire.com/…/%D8%A7%D9%84%D8%AB%D8%A7%D9%84%D… الصف الرابع http://www.mediafire.com/…/%D8%A7%D9%84%D8%B1%D8%A7%D8%A8%D… الصف الخامس http://www.mediafire.com/…/%D8%A7%D9%84%D8%AE%D8%A7%D9%85%D… الصف السادس http://www.mediafire.com/…/%D8%A7%D9%84%D8%B3%D8%A7%D8%AF%D… كل الصفوف لوكشة واحدة ( لأصحاب النت السريع ) http://www.mediafire.com/…/%D9%83%D9%86%D8%AA%D8%B1%D9%88%D… تعليمات التشغيل http://www.mediafire.com/…/%D8%AA%D8%B9%D9%84%D9%8A%D9%85%D…

ارسل تقرير عن المشاركه قام بنشر Friday في 12:05 ملف التطبيق http://www.mediafire.com/file/yr1rrb7... ============================== http://gulfup.co/itpyj0db0zzp ================================ رابط اخر https://up.top4top.net/downloadf-644qz4ck1-rar.html ============== Sub sajida() '=================== 'هذا الكود للنابغه ساجدة العزاوي 'الهدف من الكود هو استخراج وطباعه شهادات الناجحين 'كل 4 شهادات في صفحه واحده 'تم هذا الكود في 6/10/2017 '=*=*=*=*=*=*=* Dim SHehada As Worksheet, DATA As Worksheet, Z As Range Set DATA = Worksheets("رصد الترم الثانى") 'اسم شيت قاعدة البيانات Set SHehada = Worksheets("4شهادات") 'اسم الشيت الخاص بالشهادات Dim myArray, targt targt = "ناج*" 'خلية البحث Set Z = SHehada.Range("M3") '=================== c = 0 Application.ScreenUpdating = False lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row 'اخر صف به بيانات ' عدد الصفوف الخارجة عن التوزيع في ورقة مصدر البيانات For i = 7 To lr '======= If DATA.Cells(i, 101) Like targt & "*" And c = 0 Then ' If (DATA.Cells(i, 101) = "ناجــــح" Or DATA.Cells(i, 101) = "ناجحــــة") And c = 0 Then Z = DATA.Cells(i, 2) c = c + 1 '=== ' ElseIf (DATA.Cells(i, 101) Like "*" & "ناج" & "*" And c = 1 Then ElseIf DATA.Cells(i, 101) Like targt & "*" And c = 1 Then SHehada.Range("M19") = DATA.Cells(i, 2) c = c + 1 ' ElseIf (DATA.Cells(i, 101) = "ناجــــح" Or DATA.Cells(i, 101) = "ناجحــــة") And c = 2 Then ElseIf DATA.Cells(i, 101) Like targt & "*" And c = 2 Then SHehada.Range("M35") = DATA.Cells(i, 2) c = c + 1 ' ElseIf (DATA.Cells(i, 101) = "ناجــــح" Or DATA.Cells(i, 101) = "ناجحــــة") And c = 3 Then ElseIf DATA.Cells(i, 101) Like targt & "*" And c = 3 Then SHehada.Range("M51") = DATA.Cells(i, 2) c = c + 1 End If If i = lr And c = 4 Then SHehada.Range("a1:p63").PrintOut: Exit For If i = lr And c = 3 Then SHehada.Range("a1:p47").PrintOut: Exit For If i = lr And c = 2 Then SHehada.Range("a1:p31").PrintOut: Exit For If i = lr And c = 1 Then SHehada.Range("a1:p15").PrintOut: Exit For If i < lr And (SHehada.Range("M19") = "" Or SHehada.Range("M35") = "" Or SHehada.Range("M51") = "") Then GoTo 1 If i < lr And c = 4 Then SHehada.Range("a1:p63").PrintOut c = 0 Z = "" SHehada.Range("M19") = "" SHehada.Range("M35") = "" SHehada.Range("M51") = "" 1: Next i Z = "" SHehada.Range("M19") = "" SHehada.Range("M35") = "" SHehada.Range("M51") = "" Application.ScreenUpdating = True End Sub

الصف الخامس الابتدائي https://up.top4top.net/downloadf-6472fond1-rar.html **************************** الصف السادس الابتدائي https://up.top4top.net/downloadf-647imcs11-rar.html ************************

رابط جديد https://up.top4top.net/downloadf-647cenhg1-rar.html ============ الصف الثاني الابتدائي ************************* الصف الثالث الابتدائي https://up.top4top.net/downloadf-647elebf1-rar.html ***************************** ************************* الصف الرابع الابتدائي https://up.top4top.net/downloadf-647np9vq1-rar.html ***************

اصبحت الروابط لاتعمل استاذ محمد الدسوقي صاحب البرنامج

استاذ محمد الدسوقس رابط الصف الاول لايعمل

كيف يتم الفك .. بصفه عامه ؟

ربنا يحفظك ويصونك يارب استاذ mennad sofiane =================== ارجو ان تفرد موضوعا خاصا ببرنامج فك الحمايه ..

الاستاذ محمد صاحب البرنامج غير الروابط لوجود ملحوظات في الروابط الاولى وهاهي الروابط السليمه التي ارسلها لي الصف الأول الابتدائى https://up.top4top.net/downloadf-644fyhh01-rar.html الصف الثانى الابتدائى https://up.top4top.net/downloadf-644625hr1-rar.html الصف الثالث الابتدائى https://up.top4top.net/downloadf-644ncguz2-rar.html الصف الرابع الابتدائى https://up.top4top.net/downloadf-6448q4zc1-rar.html الصف الخامس الابتدائى https://up.top4top.net/downloadf-644vb2bj2-rar.html الصف السادس الابتدائى https://up.top4top.net/downloadf-644cppon3-rar.html ولأصحاب النت السريع ( كل الملفات فى مجلد واحد ) https://up.top4top.net/downloadf-644oak3b1-rar.html

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

أقدم لكم اليوم أحدث إصدار لبرنامج الكنترول المدرسى 2018 بتعديلاته الجديدة بعد إلغاء الميدتيرم كلمة سر فتح البرنامج هى 2018 ـ يمكن تغيرها بعد ذلك كما تشاء روابط التحميل الصف الأول الابتدائى https://up.top4top.net/downloadf-644oxmrq1-rar.html الصف الثانى الابتدائىhttps://up.top4top.net/downloadf-6443d66z2-rar.html الصف الثالث الابتدائى https://up.top4top.net/downloadf-6441sp3i3-rar.html الصف الرابع الابتدائى https://up.top4top.net/downloadf-644ucgqz1-rar.html الصف الخامس الابتدائى https://up.top4top.net/downloadf-644vl68z2-rar.html الصف السادس الابتدائى https://up.top4top.net/downloadf-644fepsm3-rar.html ولأصحاب النت السريع ( كل الملفات فى مجلد واحد ) https://up.top4top.net/downloadf-644ki4dr1-rar.html