kanory

نعم ممكن اختزاله ... وذلك بتعديل مسميات مربعات النص قليلا .... انظر الكود وحاول قرائته ..... وسوف ارفق المرفق قريبا ..... myT = Array("الأحد", "الإثنين", "الثلاثاء", "الأربعاء", "الخميس") For Each t In myT If Me.to.Value = t Then For i = 1 To 8 If Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] =" & i), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] =" & i), "hh:mm:ss AMPM") Then Me.Controls(t & i).BackColor = vbYellow End If Next i End If Next t

طيب ان شاء الله الفكرة التي سوف احاول تطبيقها كالتالي : ( حسب ظروفي ..... الله ييسر الامور ) اضيف حقلين Reserve و Reserve1 في الجدول كما في الصورة ( Reserve لعدد نصاب المعلم من حصص الاحتياط خلال اسبوع و حقل Reserve1 عدد حصص الاحتياط المسندة للمعلم أي كلما نقوم باسناد حصة احتياط يتغير الرقم صعودا حتى يصل لعدد حصص الاحتياط في حقل Reserve ويتوقف البرنامج تلقائيا من اسناد حصص لهذا المعلم .... وملاحظة يبدأ البرنامج باسناد حصص الاحتياط للمعلمين الاقل نصاب وهكذا ......... ___________________________________________________ عند عدم وجود معلم احتياط لحصة من الحصص يقوم البرنامج باظهار خانة اسم المعلم المنظر فارغة حتى يتم اسناد الحصة يدويا .....

ما شاء الله تبارك الله تستاهل @Moosak اعانك الله وزادك فضل ....

طيب انظر الصور .... وغير الكود الذي لديك بهذا الكود ...... Dim db As DAO.Database Dim rs As DAO.Recordset Dim rs1 As DAO.Recordset Dim rs2 As DAO.Recordset Dim i, ii, e As Integer Dim str, str1, str2 As String str = "SELECT TBL_Rserve.IdEmployee, TBL_Rserve.Id_Day, TBL_Rserve.Period1, TBL_Rserve.Period2, TBL_Rserve.Period3, TBL_Rserve.Period4, TBL_Rserve.Period5, TBL_Rserve.Period6, TBL_Rserve.Period7, TBL_Rserve.Period8, TBL_Rserve.Id_Absence FROM TBL_Rserve WHERE (((TBL_Rserve.Id_Day)=" & Me.kan & ") AND ((TBL_Rserve.Id_Absence)=2));" str1 = "SELECT TBL_Rserve3.IdEmployee, TBL_Rserve3.Id_Day, TBL_Rserve3.Period, TBL_Rserve3.Id_Period FROM TBL_Rserve3;" str2 = "SELECT TBL_Rserve.IdEmployee, TBL_Rserve.Id_Day, TBL_Rserve.Period1, TBL_Rserve.Period2, TBL_Rserve.Period3, TBL_Rserve.Period4, TBL_Rserve.Period5, TBL_Rserve.Period6, TBL_Rserve.Period7, TBL_Rserve.Period8, TBL_Rserve.Id_Absence FROM TBL_Rserve WHERE (((TBL_Rserve.Id_Day)=" & Me.kan & ") AND ((TBL_Rserve.Id_Absence)=1));" Set db = CurrentDb Set rs = db.OpenRecordset(str) Set rs1 = db.OpenRecordset(str1) Set rs2 = db.OpenRecordset(str2) rs.MoveLast: rs.MoveFirst rs2.MoveLast: rs2.MoveFirst For i = 1 To 8 rs.MoveLast: rs.MoveFirst rs2.MoveLast: rs2.MoveFirst For iii = 1 To rs.RecordCount If rs("Period" & i) > 0 Then For ii = 1 To rs2.RecordCount Dim dd As Integer dd = rs2("IdEmployee") '.Value If IsNull(rs2("Period" & i)) Then If DCount("[IdEmployee]", "TBL_Rserve3", "[IdEmployee] = " & rs2("IdEmployee") & "") = 0 Then rs1.AddNew rs1!IdEmployee = rs2!IdEmployee.Value rs1!Id_Day = rs!Id_Day rs1!Id_Period = i rs1!Period = rs("Period" & i) rs1.Update rs2.MoveNext GoTo mystnext1 End If End If rs2.MoveNext Next ii End If mystnext1: rs.MoveNext Next iii Next i rs.Close Set rs = Nothing اما بالنسبة لــــــــــــ حلها لديك بان تحدد لكل معلم امامه ... حسب نصابة من الحصص عدد معين من حصص الاحتياط في الاسبوع مثلا معلم لدية 24 حصة مثلا تخصص له حصة احتياط واحد ومعلم لدية 10 حصص تخصص له 10 حصص احتياط اسبوعية مثلا أو حسب نظام التعليم لديك .... حتى يتكمن البرنامج من توزيع الاحتياط ومع كل عملية احتياط يتم خضم واحد من حصص الاحتياط وهكذا ....... حاول التعديل وأعلمنا بالنتيجة ....

وضح ... ماهي النتائج الغير صحيحة ولا تترك الموضوع عائم ... حتى نجد حل بامرالله ... ما هي النتائج الظاهرة لديك .. صورة لها ... وصورة للصحيح ...

جرب .... Dim db As DAO.Database Dim rs As DAO.Recordset Dim rs1 As DAO.Recordset Dim rs2 As DAO.Recordset Dim i, ii, e As Integer Dim str, str1, str2 As String str = "SELECT TBL_Rserve.IdEmployee, TBL_Rserve.Id_Day, TBL_Rserve.Period1, TBL_Rserve.Period2, TBL_Rserve.Period3, TBL_Rserve.Period4, TBL_Rserve.Period5, TBL_Rserve.Period6, TBL_Rserve.Period7, TBL_Rserve.Period8, TBL_Rserve.Id_Absence FROM TBL_Rserve WHERE (((TBL_Rserve.Id_Day)=" & Me.kan & ") AND ((TBL_Rserve.Id_Absence)=2));" str1 = "SELECT TBL_Rserve3.IdEmployee, TBL_Rserve3.Id_Day, TBL_Rserve3.Period, TBL_Rserve3.Id_Period FROM TBL_Rserve3;" str2 = "SELECT TBL_Rserve.IdEmployee, TBL_Rserve.Id_Day, TBL_Rserve.Period1, TBL_Rserve.Period2, TBL_Rserve.Period3, TBL_Rserve.Period4, TBL_Rserve.Period5, TBL_Rserve.Period6, TBL_Rserve.Period7, TBL_Rserve.Period8, TBL_Rserve.Id_Absence FROM TBL_Rserve WHERE (((TBL_Rserve.Id_Day)=" & Me.kan & ") AND ((TBL_Rserve.Id_Absence)=1));" Set db = CurrentDb Set rs = db.OpenRecordset(str) Set rs1 = db.OpenRecordset(str1) Set rs2 = db.OpenRecordset(str2) rs.MoveLast: rs.MoveFirst rs2.MoveLast: rs2.MoveFirst For ii = 1 To rs2.RecordCount For iii = 1 To rs.RecordCount For i = 0 To rs.Fields.Count - 4 If Len(rs.Fields(i + 2).Value & "") = 0 Then GoTo Next_i If Len(rs2.Fields(i + 2).Value & "") < 0 Then GoTo Next_ii rs1.AddNew rs1!IdEmployee = rs2.Fields(0).Value rs1!Id_Day = rs!Id_Day rs1!Id_Period = i + 1 rs1!Period = rs.Fields(i + 2).Value rs1.Update rs2.MoveNext Next_i: Next i rs.MoveNext i = i + 1 Next iii Next_ii: Next ii rs.Close Set rs = Nothing

جرب .... واعلمنا .... قد يكون دخولي قليلا هذه الفترة .... عند وجود ملاحظات حاول طرحها ربما تجد من هو متواجد بكثرة الاجابة ... ‏‏‏‏‏‏‏‏برنامج الاحتياطي 2022 - Kan.accdb

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

جرب هذا مع تغيير بيانات الكود حسب بيانات النموذج لديك ...... Dim strnum As String Dim iCounter As Integer Dim arrnum() As String Dim Rep_lace As String strnum = Me.kan Rep_lace = Replace(strnum, "(", "") Rep_lace = Replace(Rep_lace, ")", "") arrnum = Split(Rep_lace, "-") For iCounter = LBound(arrnum) To UBound(arrnum) If arrnum(iCounter) > 5 Then With Me.kan .FontBold = True .ForeColor = 255 End With Else With Me.kan .FontBold = False .ForeColor = 0 End With End If Next

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

لا يعمل .... يعني لا يعطي ولا رسالة خطأ ؟؟؟ اعرض لنا فحوى الرسالة حتى نعرف !!!

تفضل ....... استبدل الكود بهذا ..... On Error Resume Next Dim strSQL As String Set db = CurrentDb strSQL = "SELECT [ورقة1$].[اسم الطالب], [ورقة1$].الصف, [ورقة1$].الشعبه, [ورقة1$].الديانه, [ورقة1$].النوع, * FROM [ورقة1$] IN '" & TheFile & "'[Excel 5.0;HDR=NO;IMEX=0;];" Set qdf = db.CreateQueryDef("kanory", strSQL) DoCmd.SetWarnings False DoCmd.RunSQL " SELECT kanory.[اسم الطالب], kanory.الصف, kanory.الشعبه, kanory.الديانه, kanory.النوع INTO Degrees FROM kanory;" DoCmd.SetWarnings True MsgBox "تم" ملفك ... 299.ImportDegrees2022.accdb

طيب يا عم ...... فكرتين لطريقتين : الاولى : استخدام HTML في اظهار الصور الموجودة في الملجلد وقد لمح لها أخي الفاضل @jjafferr في طريقة الاستاذ القدير @ابو إبراهيم ولهما مني التحية والتقدير الثانية : استخدام عملية توزيع للمسارات على حقول في جدول لنتمكن من عرض الصور بشكل شبكي ملاحظة : عند فتح المجلد المراد اختر واحدة من الصور فقط والبرنامج يقوم بجلب جميع صور المجلد .... تفضل ........ هناك فكرة ثالثة ... لكن للاسف لم اتمكن حتى الان من تطبيقها لضيق الوقت ... Kan_first idea.accdb Kan_second idea.accdb

طيب هذه كمان طريقة اخرى بس في اشياء في ذهني خلها تتبلور وتتنفذ حنزل الطريقتين معا ....

لم افهم مرتبطة ... ماذا تقصد منها .... هل تريد عند الضغط عليها تفتح مثلا .... ام ماذا ؟؟؟؟؟؟ فكرت بطريقة جالس اخطط لها انظر الصورة ..... ؟؟؟؟ !!!!!

ممكن تعملها داخل نموذج فرعي في نموذج رئيسي ..... تفضل ..... اللجان والتصحيح7.4.accdb

دائما سباق للخير أخي العزيز

ملاحظة للفائدة : غير مفيد جعل الترقيم التلقائي مفتاح .... لذلك اجعل المفتاح رقم الهوية مثلا .... وهناك تعديلات حسب طبيعة برنامجك ... لا نستطيع اجبارك عليها مثل رقم خاص لكل فرد من افراد الاسرة ... تفضل ..... test (4).accdb ههههههههه .... اعتذر منك اخي لان الاجابة كانت في نفس الوقت

تفضل >>>>>>>> test (3).accdb

متابع ومنتظر ... تشكر على الامثلة الرائعة

نماذج وابداعات جميلة اخي @Moosak شكرا لك ...

بل انت انسان عسل وسهل وانا شخصيا اعتبرك فاكهة المنتدي .... ما شاء الله عليك ..... بارك الله فيك وفي تواضعك الجم .... أسأل الله تعالى لك وللجميع التوفيق ,,,,,

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

تفضل هذا ما يقصده اخي @ناقل Database_kan.accdb

طيب جرب كده ........ kan_الغياب.accdb