علي المصري

السلام عليكم ورحمة الله وبركاته أستاذ jjafferr اليك ما توصلت إليه في الموضوع توجد فورم Follow 4 عند فتح الفورم وغلقها دون تسجيل أي شيئ بتم إضافة صف جديد في الجدول tbl_Follow4 ( صف فارغ ) فكيف يمكن التغلب على ذلك اما التقرير Rpt_Follow4 هل يمكن اظهار أيام الأسبوع من الاحد إلى الخميس حتى اذا كان اليوم غير مسجل غياب او تأخر للطالب ثم عند ظهور بداية الأسبوع التالي يتم ترك مسافة فارغة بينه وبين الأسبوع الذي يسبقه شكرا AbsentLate 2016.rar

شكرا أستاذ الجليل الأستاذ جعفر على اهتمامك ونصائحك العالية التي استفيد منها دائما فانا تلميذ هذا الصرح العملاق وما زلت اتعلم شكرا جزيلاً

up

up

Up

السلام عليكم ورحمة الله وبركاته - في المرفق ثم تصميم فورم تحت اسم Frm_LessonAbsent2 يحتوي على الصف وعند اختيار الشعبة تظهر أسماء الطلاب ولكن لا تعطي أي بيانات عند اختيار الصف والشعبة * اريد حل هذه المشكلة * اريد ان يتم تخزين البيانات في الجدول tbl_lessonAbsent أو الجداول المخصصة لكل يوم * ثانيا : اريد عمل تقرير يوضح الغياب والتأخر لكل طالب على مدار الأسبوع قمت بعمل تقرير تحت اسم tbl_LessonAbsent وهو يعطي كل طالب في صفحه مستقله والأيام المسجل بها الغياب او التأخر كما بالشكل التالي : ولكن عند التنفيذ اجد اسم الطالب وتاريخ يوم واحد فقط في الصفحة والتاريخ الاخر في صفحة جديدة اريد تصميم تقرير كما بالشكل التالي الخميس Thursday 24/11/2016 الأربعاء Wednesday 23/11/2016 الثلاثاء Tuesday 22/11/2016 الاثنين Monday 21/11/2016 الاحد Sunday 20/11/2016 StName esis id 9 8 7 6 5 4 3 2 1 9 8 7 6 5 4 3 2 1 9 8 7 6 5 4 3 2 1 9 8 7 6 5 4 3 2 1 9 8 7 6 5 4 3 2 1 مع العلم ان عدد الحصص للصفوف من Grade 6 إلى Grade 9 سبع حصص يوميا عدد الحصص للصفوف من Grade 10 إلى Grade 12 تسع حصص يوميا فهل يمكن تنفيذ هذه الفكرة Absent Late.rar

افتح التقرير في وضع التصميم

افتح الجدول Table1 في وضع التصميم وغير توع البيانات للسجل number غيره من short text إلى number

السلام عليكم ورحمة الله وبركاته اخي الكريم يمكنك اختصار الكود الخاص بك في فورم invoice الكود الخاص بك هو : d1.Value = Val(b1) * Val(c1) d2.Value = Val(b2) * Val(c2) d3.Value = Val(b3) * Val(c3) d4.Value = Val(b4) * Val(c4) d5.Value = Val(b5) * Val(c5) d6.Value = Val(b6) * Val(c6) d7.Value = Val(b7) * Val(c7) d8.Value = Val(b8) * Val(c8) d9.Value = Val(b9) * Val(c9) d10.Value = Val(b10) * Val(c10) d11.Value = Val(b11) * Val(c11) d12.Value = Val(b12) * Val(c12) d13.Value = Val(b13) * Val(c13) d14.Value = Val(b14) * Val(c14) d15.Value = Val(b15) * Val(c15) d16.Value = Val(b16) * Val(c16) d17.Value = Val(b17) * Val(c17) d18.Value = Val(b18) * Val(c18) d19.Value = Val(b19) * Val(c19) d20.Value = Val(b20) * Val(c20) d21.Value = Val(b21) * Val(c21) d22.Value = Val(b22) * Val(c22) d23.Value = Val(b23) * Val(c23) d24.Value = Val(b24) * Val(c24) d25.Value = Val(b25) * Val(c25) d26.Value = Val(b26) * Val(c26) d27.Value = Val(b27) * Val(c27) d28.Value = Val(b28) * Val(c28) d29.Value = Val(b29) * Val(c29) d30.Value = Val(b30) * Val(c30) d31.Value = Val(b31) * Val(c31) d32.Value = Val(b32) * Val(c32) d33.Value = Val(b33) * Val(c33) d34.Value = Val(b34) * Val(c34) d35.Value = Val(b35) * Val(c35) d36.Value = Val(b36) * Val(c36) d37.Value = Val(b37) * Val(c37) d38.Value = Val(b38) * Val(c38) d39.Value = Val(b39) * Val(c39) d40.Value = Val(b40) * Val(c40) الكود بعد الاختصار هو Dim i As Integer For i = 1 To 40 Controls("d" & i).Value = Val(Controls("b" & i)) * Val(Controls("c" & i)) Next i

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

جرب التالي Private Sub Text482_AfterUpdate() If Me.Text482 = 0 Then Me.Qproduced.Enabled = False MsgBox "Can not produce becuase the avalialbe limit of raw material is equal to zero", vbOKOnly, "Attention" Else Me.Qproduced.Enabled = True End If End Sub

شكرا جزيلا اخي أبوخليل جزاك الله خيرا وكل عام انتم بخير

up

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

شكرا جزيلا أخي الأستاذ ياسر العربي واخي الأستاذ أبو حنين الكود التالي كتبته في احد الردود وهو مماثل للكود الذي تفضل به الأستاذ الفاضل ياسر العربي وعند المراجعة وجد التالي الكود الذي اعمل عليه كان مسبوق بالامر التالي ActiveSheet.Protect Password:="123" أي ان الورقة سوف يتم حمايتها أولا ثم يتم تنفيذ باقي الكود الخاص بالتنسيق مما أدى إلى ظهور الرسالة التي تفيد ان هناك خطأ ولقد تنبهت إليه بعد المناقشات التي تمت في الموضوع وبفضل الله ثم الأستاذ ياسر العربي والأستاذ أبو حنين اكتشفت هذا الخطأ فلكي اتغلب على هذه المشكلة والمحافظة على حماية الورقة كتب الكود كالتالي: Private Sub Worksheet_Activate() ActiveSheet.Unprotect Password:="AliElbasry123" 'هذا الجزء خاص بتحويل اتجاه الورقة Select Case CStr(AliElbasry.Range("I5")) Case Is = "2": Me.DisplayRightToLeft = False Case Is = "1": Me.DisplayRightToLeft = True End Select 'هذا الجزء خاص بعملية التنسيق المطلوبة If AliElbasry.Range("I5") = 1 Then With AliElbasry2.Range("C5:G5").Font .Name = "Times New Roman" .FontStyle = "Bold" .Size = 14 End With Else With AliElbasry2.Range("C5:G5").Font .Name = "Candara" .FontStyle = "Bold" .Size = 14 End With End If ActiveSheet.Protect Password:="123" End Sub 'شكرا جزيلا استاذ ياسر العربي وشكرا جزيلا استاذ أبو حنين اعذروني الدنيا رمضان والناس صايمة

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

السلام عليكم ورحمة الله وبركاته شكرا استاذنا الفاضل ياسر العربي هذا اذا كانت الخلية في نفس الورقة اما اذا كانت الخلية التي تحتوي على الرقم 1 أو 2 في ورقة ومطلوب تنفيذ الكود على خلية أخرى في ورقة اخرى الكود لا يعمل الكود كما يلي If AliElbasry.Range("I5") = 1 Then With AliElbasry2.Range("C5").Font .Name = "Arial" .FontStyle = "Bold" .Size = 14 End With Else With AliElbasry2.Range("C5").Font .Name = "Candara" .FontStyle = "Bold" .Size = 14 End With End If حيث AliElbasry هي الورقة التي تحتوي على الخلية التي بها الرقم 1 أو 2 وهي الخلية I5 و AliElbasry2 هي الورقة المراد تطبيق الكود عليها وفي هذه الحالة هي الخلية C5 مع العلم انه مدمج معها اكثر من خلية ( C5:G5 ) فهل من حل؟؟؟؟؟؟؟؟؟؟ اريد الكود في حدث تنشيط الورقة AliELbasry2 Private Sub Worksheet_Activate()

اريد عمل تنسيق باستخدام vba لدي الخلية C2 بها الرقم اما 1 او 2 إذا كان الرقم الموجود 1 اريد تنسيق الخلية كما يلي الخط = times newroman Bold font.size =14 واما اذا كان الرقم 2 فإن الخط يكون Candara والباقي كما هو انا استخدمت التالي ولكن لم يعمل وتظهر رسالة خطأ with Cells(2,3).font .name ="Times New Roman" .Fontstyle="Bold" .size=14 end with

مبارك على الترقية

مبارك على الترقية

شكرا استاذ سليم جزاك الله خبرا كود ممتاز Dim R As Integer Application.ScreenUpdating = False Sheet1.Range("I6:L35").ClearContents For R = 6 To 35 For t = 4 To 7 With Sheet1 Select Case UCase(.Cells(R, t).Value) Case "A" .Cells(R, t + 5) = 90 Case "B" .Cells(R, t + 5) = 80 Case "C" .Cells(R, t + 5) = 70 Case "D" .Cells(R, t + 5) = 60 Case "E" .Cells(R, t + 5) = 50 Case Else .Cells(R, t + 5) = "" End Select End With Next Next Application.ScreenUpdating = True

شكرا اخي ياسر تم حل المشكلة كالتالي: قمت بعمل End لكل If لحالها كالتالي : Sub DoMyOrder() Dim R As Integer For R = 2 To 31 If Sheet1.Cells(R, 2) = "" Then Sheet1.Cells(R, 9) = "" ElseIf Sheet1.Cells(R, 2) = "A" Then Sheet1.Cells(R, 9) = "90" ElseIf Sheet1.Cells(R, 2) = "B" Then Sheet1.Cells(R, 9) = "80" ElseIf Sheet1.Cells(R, 2) = "C" Then Sheet1.Cells(R, 9) = "70" ElseIf Sheet1.Cells(R, 2) = "D" Then Sheet1.Cells(R, 9) = "60" ElseIf Sheet1.Cells(R, 2) = "E" Then Sheet1.Cells(R, 9) = "50" End If '================================ If Sheet1.Cells(R, 3) = "" Then Sheet1.Cells(R, 10) = "" ElseIf Sheet1.Cells(R, 3) = "A" Then Sheet1.Cells(R, 10) = "90" ElseIf Sheet1.Cells(R, 3) = "B" Then Sheet1.Cells(R, 10) = "80" ElseIf Sheet1.Cells(R, 3) = "C" Then Sheet1.Cells(R, 10) = "70" ElseIf Sheet1.Cells(R, 3) = "D" Then Sheet1.Cells(R, 10) = "60" ElseIf Sheet1.Cells(R, 3) = "E" Then Sheet1.Cells(R, 10) = "50" End If '============================== If Sheet1.Cells(R, 4) = "" Then Sheet1.Cells(R, 11) = "" ElseIf Sheet1.Cells(R, 4) = "A" Then Sheet1.Cells(R, 11) = "90" ElseIf Sheet1.Cells(R, 4) = "B" Then Sheet1.Cells(R, 11) = "80" ElseIf Sheet1.Cells(R, 4) = "C" Then Sheet1.Cells(R, 11) = "70" ElseIf Sheet1.Cells(R, 4) = "D" Then Sheet1.Cells(R, 11) = "60" ElseIf Sheet1.Cells(R, 4) = "E" Then Sheet1.Cells(R, 11) = "50" End If '======================== If Sheet1.Cells(R, 5) = "" Then Sheet1.Cells(R, 12) = "" ElseIf Sheet1.Cells(R, 5) = "A" Then Sheet1.Cells(R, 12) = "90" ElseIf Sheet1.Cells(R, 5) = "B" Then Sheet1.Cells(R, 12) = "80" ElseIf Sheet1.Cells(R, 5) = "C" Then Sheet1.Cells(R, 12) = "70" ElseIf Sheet1.Cells(R, 5) = "D" Then Sheet1.Cells(R, 12) = "60" ElseIf Sheet1.Cells(R, 5) = "E" Then Sheet1.Cells(R, 12) = "50" End If Next End Sub بارك الله فيك لقد توصلت لها من خلال الرد الأخير الخاص بحضرتك شكرا جزيلاً

ثم حذف esis من الطرف اليسار واختيار T1 ثم تعديل وكتابة قيم السلسة عبارة عن الاسم Term_1 الموضح في بداية الرد وكذلك بالمثل ل T2 , T3 , Final ثم في الجزء اليمين عملت تعديد وكتبت به الاسم MyNumbers فيصبح الرسم البياني ذو نطاق ديناميكي وهذا ما اتمناه بالفعل ولكن المشكلة كما وضح في الرد السابق مع كتابة المعادلات في الخلايا المرفق الذي تكلمت عنه بالشرح AAAA.rar

Term_1 =OFFSET(AliElbasry!$I$2;0;0;COUNTA(AliElbasry!$I:$I)-1) final=OFFSET(AliElbasry!$L$2;0;0;COUNTA(AliElbasry!$L:$L)-1) MyNumbers==OFFSET(AliElbasry!$G$2;0;0;COUNTA(AliElbasry!$G:$G)) Term_2=OFFSET(AliElbasry!$J$2;0;0;COUNTA(AliElbasry!$J:$J)-1) Term_3=OFFSET(AliElbasry!$K$2;0;0;COUNTA(AliElbasry!$K:$K)-1) اما الرسم البياني قمت بتحديد النطاق من G1 إلى K31 ثم ادراج رسم بياني كليك يمين واختيار من القائمة تحديد البيانات ( select data ) تظهر الشاة التالية

شكرا جزيلا أستاذ ياسر على اهتمامك عند استخدام المعادلات إذا كانت القائمة بالأسماء 30 اسم مع بيانتهم لا يوجد مشكلة اما اذا كان في الصف 24 طالب مثلا نجد ان الرسم البياني به جزء فارغ انا لا اريد هذا الفراغ