ناصر سعيد

جزاك الله كل خير .. استاذ مجدي لو سمحت خفف درجة اللون في الصوره عشان الكتابه تظهر بوضوح

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

لعل هذا الموضوع يفيدك

مرفق به زياده مجرد كتابه عدد اللجان المطلوبه في صفحه بيانات الطلبة يتم توزيعهم اوتوماتيكيا تـــوزيع اللجان بكتابه عدد اللجان.rar

============================= توزيع اللجان.rar

اضافه كشوف اللجان .. ادعو الله ان تحوز اعجابكم بمعادلتين مختلفتين وكود للطباعه راائع '------------------------------ Sub PrintFrom_To_() MsgBox "للحصول على طباعة كاملة يجب عدم ملامسة الماوس أو لوحة المفاتيح أثناء الطباعة" Dim I As Integer For I = Range("O8") To Range("P8") Step 2 If I <= Range("P8") Then Range("D4") = I ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate:=True End If Next I Range("e5").Select End Sub معادلات استجلاب البيانات =IF(COUNTIF('بيانات الطلبة'!$R$6:$R$2030;$D$4)<ROWS(B$9:B9);"";INDEX('بيانات الطلبة'!$E$6:$E$2030;100000-SUMPRODUCT(LARGE(('بيانات الطلبة'!$R$6:$R$2030=$D$4)*(100000-ROW('بيانات الطلبة'!$R$6:$R$2030));ROWS(B$9:B9)))-5)) ======= والمعادله الثانيه معادله صفيف للمحترم بن عليه هي =IF($B9="";"";INDEX(MyRng;SMALL(IF('بيانات الطلبة'!$R$7:$R$1000=$D$4;ROW($7:$1000)-6);$B9);4))

التاريخ الهجري تمام التمام ... الاستاذ الكبير مجدي يونس

اضافه كشوف اللجان .. ادعو الله ان تحوز اعجابكم بمعادلتين مختلفتين وكود للطباعه راائع Sub PrintFrom_To_() MsgBox "للحصول على طباعة كاملة يجب عدم ملامسة الماوس أو لوحة المفاتيح أثناء الطباعة" Dim I As Integer For I = Range("O8") To Range("P8") Step 2 If I <= Range("P8") Then Range("D4") = I ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate:=True End If Next I Range("e5").Select End Sub ================================ معادلات استجلاب البيانات =IF(COUNTIF('بيانات الطلبة'!$R$6:$R$2030;$D$4)<ROWS(B$9:B9);"";INDEX('بيانات الطلبة'!$E$6:$E$2030;100000-SUMPRODUCT(LARGE(('بيانات الطلبة'!$R$6:$R$2030=$D$4)*(100000-ROW('بيانات الطلبة'!$R$6:$R$2030));ROWS(B$9:B9)))-5)) ======================== والمعادله الثانيه معادله صفيف للمحترم بن عليه هي =IF($B9="";"";INDEX(MyRng;SMALL(IF('بيانات الطلبة'!$R$7:$R$1000=$D$4;ROW($7:$1000)-6);$B9);4)) توزيع اللجان.rar

معادله احصاء ب3 شروط =SUMPRODUCT((($K$10:$K$1000="ذكر")*($AE$10:$AE$1000="ناجح")*($BU$10:$BU$1000="الرابع")))

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

جزاك الله كل خير .. على البركه ان شاء الله

يبدو من الجهاز لو احد الاخوة الذين حملوا الملف يشوف انا التاريخ

ورقة النتيجه فيها ان السبت 28 جمادى الاول مش الجمعه

============================== طباعة ارقام الجلوس للمحترم ياسر العربي الكود مع الشرح Private Sub CommandButton1_Click() Dim x As Long, y As Long, z As Byte ' وضع قيمة التكست بوكس 2 داخل المتغير Y y = TextBox2.Value ' وضع قيمة التكست بوكس 3 داخل المتغير Z z = TextBox3.Value 'حلقة تكرارية بداية من التكست بوكس 1 الى المتغير واي الذي يحمل قيمة التكست2 For x = TextBox1.Value To y 'هنا يتم وضع ارقام الجلوس تباعا لكل خلية من التسع خلايا 'اول خلية تساوى المتغير اكس والذي يحمل ارقام الجلوس التى حددناها من قبل 'والخلية التالية نضع املتغير اكس بالاضافة الى واحد ليحمل رقم الجلوس التالي 'وهكذا مع الخلايا الاخرى الخاصة بارقام الجلوس 'اما الشروط المضافة بجانب الخلايا IF[]>y then []="" 'فهذه تم وضعها فقط للتأكد من ان قيمة الخلايا لا تزيد عن اخر رقم جلوس وهو ما يحمله المتغير واي 'فاذا تحقق الشرط وكان رقم الجلوس اكبر من اخر رقم يتم مسحه وهذه الشروط لا نستعملها الا في اخر صفحة يتم طباعتها [B6] = x: If [B6] > TextBox2.Value Then [B6] = "" [B16] = x + 3: If [B16] > y Then [B16] = "" [B26] = x + 6: If [B26] > y Then [B26] = "" [H6] = x + 1: If [H6] > y Then [H6] = "" [H16] = x + 4: If [H16] > y Then [H16] = "" [H26] = x + 7: If [H26] > y Then [H26] = "" [N6] = x + 2: If [N6] > y Then [N6] = "" [N16] = x + 5: If [N16] > y Then [N16] = "" [N26] = x + 8: If [N26] > y Then [N26] = "" 'سطر الطباعة وعدد النسخ تساوي z 'والتى تساوي تكست بوكس تلاته التى نضع بها عدد النسخ المطلوبة ActiveWindow.SelectedSheets.PrintOut Copies:=z ', Preview:=True 'هنا نقوم باضافة ثمانية ارقام الى المتغير اكس ليصبح محموعهم 9 ليتخطى تسع ارقام جلوس كل دورة 'داخل الحلقة التكرارية حتى نهاية الحلقة x = x + 8 'نكست اي يعود مرة اخرى لاول الحلقة التكرارية لتطبيق الاكواد مرة اخرى Next MsgBox "Done.....", 64 Me.Hide End Sub Private Sub UserForm_Activate() 'هنا في حدث تنشيط الفورم 'تكست واحد تساوى اول رقم جلوس TextBox1.Text = Sheets("بيانات الطلبة").Range("B7").Value 'تكست2 تساوي اخر رقم جلوس TextBox2.Text = Sheets("بيانات الطلبة").Range("B" & Sheets("بيانات الطلبة").Cells(Rows.Count, 2).End(xlUp).Row).Value End Sub

بخصوص التاريخ اولا اليوم الجمعه وياتي بالسبت ثانيا وبالنسبه للتاريخ الهجري زايد يوم المفروض مع السبت يجي 28 جما د ى الاول مكتوب 29 جمادى الاول

============================== طباعة ارقام الجلوس للمحترم ياسر العربي ارقام الجلوس.rar Private Sub CommandButton1_Click() 'هذا الكود للمحترم ياسر العربي 'وهو خاص باستخراج ارقام الجلوس لطلاب المدارس 'تم هذا الكود في 22/2/2017 Dim x As Long, y As Long, z As Byte y = TextBox2.Value z = TextBox3.Value For x = TextBox1.Value To y [B6] = x: If [B6] > TextBox2.Value Then [B6] = "" [B16] = x + 3: If [B16] > y Then [B16] = "" [B26] = x + 6: If [B26] > y Then [B26] = "" [H6] = x + 1: If [H6] > y Then [H6] = "" [H16] = x + 4: If [H16] > y Then [H16] = "" [H26] = x + 7: If [H26] > y Then [H26] = "" [N6] = x + 2: If [N6] > y Then [N6] = "" [N16] = x + 5: If [N16] > y Then [N16] = "" [N26] = x + 8: If [N26] > y Then [N26] = "" ActiveWindow.SelectedSheets.PrintOut Copies:=z ', Preview:=True x = x + 8 Next MsgBox "Done.....", 64 Me.Hide End Sub Private Sub UserForm_Activate() TextBox1.Text = Sheets("بيانات الطلبة").Range("B7").Value TextBox2.Text = Sheets("بيانات الطلبة").Range("B" & Sheets("بيانات الطلبة").Cells(Rows.Count, 2).End(xlUp).Row).Value End Sub

كود لاظهار اعمدة مختلفة او متجاورة للمحترم سليم حاصبيا Sub hide_some_columns() With Sheets("sheet1") .Columns.Hidden = True .Range("a1,b1,c1,g1").EntireColumn.Hidden = False Application.Goto Reference:=.Range("b1") End With Sheets("sheet1").Activate End Sub كود لاظهار اعمدة مختلفة او متجاورة للمحترم ياسر العربي Sub yasser3() Columns("D:XFD").EntireColumn.Hidden = True Range("K:L,O:P,S:T,Z:Z").EntireColumn.Hidden = False End Sub

استاذ مجدي يونس حفظك الله ورعاك بحق انت استاذ في شرحك

Sub hide_some_columns() With Sheets("sheet1") .Columns.Hidden = True .Range("a1,b1,c1,g1").EntireColumn.Hidden = False Application.Goto Reference:=.Range("b1") End With Sheets("sheet1").Activate End Sub جزاك الله خيرا ..

للرفع

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

استاذ الاساتذه مجدي يونس جزاك الله كل خير اللهم اني اسالك بحقك ان تمد المحترم مجدي يونس بالصحه وراحة البال .. أمين جاري التجربه والافاده ======================================= ارجو ان تفرد لنا موضوعا عن برنامج الشرح وكيفيه شرح البرامج ورفعها ... ربما يستفيد منها احد فيشرح درسا اخر يكون لك فيه ايضا الاجر والثواب ان شاء الله

عند تطبيقه على ملف لم يتم المراد والمرفق موجود ارجو تضبيطه الملف للمحترم سليم حاصبيا.rar

الله يسعد ايامك استاذ سليم Sub hide_some_columns() Sheets("sheet1").Columns.Hidden = True Range("b1,c1,d1,r1").EntireColumn.Hidden = False Range("b1").Select End Sub

تمام .. غير الخلفيه بالطريقه اللي تعجبك فأنت أستاذ