Hamtoooo قام بنشر أكتوبر 9, 2023 قام بنشر أكتوبر 9, 2023 السلام عليكم اسعد الله اوقاتكم بكل خير الفكرة : ----------------------- لدي جدول اقوم فيه بتسجيل الدورات للموظفين لدي بالحقول التالية namee اسم الموظف num رقم الموظف Cname اسم الدورة Cstart بداية تاريخ الدورة Cend نهاية تاريخ الدورة المطلوب : ----------------------- لنفترض ان لدي موظف اسمه احمد ورقمه 1020 مسجل مسبقا بدوره تبدا من تاريخ 1-10-2023 حتى تاريخ 15-10-2023 الان اريد عندما اسجل الموظف احمد بدورة اخرى والتي ستبدأ بتاريخ 5-10-2023 يرفض التسجيل ويتم تنبيهي بأن الموظف المسجل هو بالفعل في دورة الان. المرفق لتجاربكم : ----------------------- دورات.accdb
Hamtoooo قام بنشر أكتوبر 9, 2023 الكاتب قام بنشر أكتوبر 9, 2023 (معدل) 9 دقائق مضت, kkhalifa1960 said: تفضل أخي محاولتي . مرحبا فيك اخي اشكرك على مشاركتك لكن لا يفي بالغرض حيث انني قمت باضافة دورة ولم ينبهني بان الموظف في دورة الان وقبل الاضافة كما انني اريد ان لا يقبل نهائيا اذا كان الموظف في دوره الان اي ان الموظف دورته بدأت من تاريخ 1 وتنتهي في 10 عندما اريد تسجيل دوره اخرى للموظف نفسه تبدأ بتاريخ 7 لا يقبل لانه مرتبط بدوره حاليا القصد هو ان لا يقبل الاضافه اذا كانت بدايه تاريخ الدوره ونهايتها يقع في حرم دورة اخرى واريد كذلك الاستغناء عن الاستعلام الذي وضعته حيث اعتقد يمكنك الاستفاده من الجدول مباشره لجلب ما اذا كان تاريخ الدورة يكون بين تاريخين او لا تم تعديل أكتوبر 9, 2023 بواسطه Hamtoooo
ابو جودي قام بنشر أكتوبر 9, 2023 قام بنشر أكتوبر 9, 2023 فى مربع النص الخاص بكتابة تاريخ بدء الدورة استخدم الكود الاتى قبل التحديث Dim mxDate As Date mxDate = DMax("[Cend]", "courses", "[num] =" & Me.رقم_الموظف & "") If Me.بداية_الدورة <= mxDate Then Cancel = True: Me.Undo: MsgBox "nooooooooooo" 2
ابوخليل قام بنشر أكتوبر 9, 2023 قام بنشر أكتوبر 9, 2023 مشاركة مع احبتي واقتباس من ابي جودي لاحظ تغير مسميات الحقول في النموذج Private Sub Cstart_BeforeUpdate(Cancel As Integer) Dim Date1, Date2, tstDate As Date tstDate = Me.Cstart Date1 = DMax("[Cstart]", "courses", "[num] =" & Me.num) Date2 = DMax("[Cend]", "courses", "[num] =" & Me.num) If (tstDate >= Date1) And (tstDate <= Date2) Then Cancel = True: Me.Undo: MsgBox "nooooooooooo" End Sub 1
Foksh قام بنشر أكتوبر 9, 2023 قام بنشر أكتوبر 9, 2023 (معدل) اخي الكريم ، هذا مثال جزء من برنامج ادارة صالات الأفراح ، وفيه فكرة الحجز بتاريخ لصالات ، هي مجرد فكرة جربها ( 10001 و 10002 ) لتجربة الحجز بتاريخ محدد ، وجرب حجز موعد بتاريخ آخر لنفس الرقم Afra7 2023.zip تم تعديل أكتوبر 9, 2023 بواسطه Foksh 1
Moosak قام بنشر أكتوبر 9, 2023 قام بنشر أكتوبر 9, 2023 مشاركتي مع الأحبة 🙂 تضع هذا في حدث قبل التحديث للنموذج (غيرت المسميات بالإنجليزي) : Private Sub Form_BeforeUpdate(Cancel As Integer) Dim C As Integer C = DCount("*", "[courses]", "([num] =" & Me.num & ") and (([Cstart] Between #" & Me.Cstart & "# And #" & Me.Cend & "#) Or ([Cend] Between #" & Me.Cstart & "# And #" & Me.Cend & "#))") If C > 0 Then MsgBox "الموظف مسجل في دورة أخرى في نفس التوقيت" Cancel = True End If End Sub دورات.accdb 1
ابو جودي قام بنشر أكتوبر 9, 2023 قام بنشر أكتوبر 9, 2023 وبصراحة لأنى كنت فى عجلة من أمرى وقت وضع الاجابة والتى لا تملئنى بكل الرضا لذلك لم اهتم بوضع القاعدة بالتطبيق سوف اقوم الان بعمل الالية التى لو كنت مكانك لاستخدمتها على الفور 1
ابو جودي قام بنشر أكتوبر 9, 2023 قام بنشر أكتوبر 9, 2023 الشرح والمرفق اولا سوف استخدم نموذج غير منضم لادراج البيانات الى الجدول وسوف اقوم بعمل وحدة نمطية واقوم بإضافة الكود الاتى Public Function ClearControls(ByRef Frm As Access.Form) On Error GoTo errClear Dim ctr As Access.Control For Each ctr In Frm.Controls If ctr.Tag = "ctrClear" Then ctr.Value = Null Next ctr Exit Function errClear: MsgBox Err.Number & " " & Err.Description & " in Clear Controls" Resume Next End Function وظيفة الكود الدوران على جميع عناصر التحكم فى النموذج ليقوم بتغيير القيم الى Null وطبعا لانى لو اردت استخدامه على عناصر محدده دون أخرى أو استخدامه فى نماذج اخرى منضمه لن أحدد نوع عناصر التحكم فى الكود ولكن سوف استخدم وظيفة التاج على عناصر التحكم يعنى سوف يقوم الكود بالدوران على جميع عناصر التحكم فى النموذج ليغير قيمها الى Null عند تحقق الشرط وجود كلمة ctrClear فى خاصية التاج على عناصر التحكم مثل الصورة الاتية طبعا يتم استخدام هذا الكود باستدعاءه عند الضغط على زر جديد كالتالى Call ClearControls(Me) والان عند الضغط على زرحفظ نريد منه عند تحقق الشرط بعدم وجود تسجيل لنفس الموظف فى دورة جديدة فى حالة تسجيل نفس الموظف فى دورة أخرى ضمن تاريخ انعقاد الدورتان اى لابد ان تنتهى أى دروة سابقة وكذلك لن يمكن تسجيل تاريخ اقل من أو يساوى تاريخ اى دورة انتهت يكون الكود بالشكل الاتى عند التحقق من التاريخ لو النتيجة المطلوبة صحيحه يتم حفظ البيانات فى الجدول من خلال اضافة البيانات عن طريف الـ Recordset Dim db As DAO.Database: Dim rs As DAO.Recordset: Dim strMsg As String: Dim strTitle As String Dim dtmMaxStartDate As Date: Dim dtmMaxEndDate As Date: Dim dtmNewDate As Date dtmNewDate = Me.txtCstart dtmMaxStartDate = DMax("[Cstart]", "courses", "[num] =" & Me.txtNo) dtmMaxEndDate = DMax("[Cend]", "courses", "[num] =" & Me.txtNo) strMsg = ChrW(32) & ChrW(1607) & ChrW(1606) & ChrW(1575) & ChrW(1603) & ChrW(32) & ChrW(1583) & ChrW(1608) & ChrW(1585) & ChrW(32) & ChrW(1605) & ChrW(1606) & ChrW(1593) & _ ChrW(1602) & ChrW(1583) & ChrW(1577) & ChrW(32) & ChrW(1576) & ChrW(1575) & ChrW(1604) & ChrW(1601) & ChrW(1593) & ChrW(1604) & ChrW(32) & ChrW(1601) & ChrW(1609) & _ ChrW(32) & ChrW(1606) & ChrW(1591) & ChrW(1575) & ChrW(1602) & ChrW(32) & ChrW(1578) & ChrW(1575) & ChrW(1585) & ChrW(1610) & ChrW(1582) & ChrW(32) & ChrW(1575) & _ ChrW(1604) & ChrW(1583) & ChrW(1608) & ChrW(1585) & ChrW(1577) & ChrW(32) & ChrW(1575) & ChrW(1604) & ChrW(1580) & ChrW(1583) & ChrW(1610) & ChrW(1583) & ChrW(1577) & _ ChrW(32) & ChrW(1604) & ChrW(1607) & ChrW(1584) & ChrW(1575) & ChrW(32) & ChrW(1575) & ChrW(1604) & ChrW(1605) & ChrW(1608) & ChrW(1592) & ChrW(1601) & ChrW(13) & _ ChrW(10) & ChrW(1604) & ChrW(1606) & ChrW(32) & ChrW(1610) & ChrW(1578) & ChrW(1605) & ChrW(32) & ChrW(1578) & ChrW(1587) & ChrW(1580) & ChrW(1610) & ChrW(1604) & _ ChrW(32) & ChrW(1576) & ChrW(1610) & ChrW(1575) & ChrW(1606) & ChrW(1575) & ChrW(1578) & ChrW(32) & ChrW(1607) & ChrW(1584) & ChrW(1575) & ChrW(32) & ChrW(1575) & _ ChrW(1604) & ChrW(1605) & ChrW(1608) & ChrW(1592) & ChrW(1601) & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & ChrW(1571) & ChrW(1608) & ChrW(32) & ChrW(1571) & _ ChrW(1606) & ChrW(1603) & ChrW(32) & ChrW(1578) & ChrW(1581) & ChrW(1575) & ChrW(1608) & ChrW(1604) & ChrW(32) & ChrW(1578) & ChrW(1587) & ChrW(1580) & _ ChrW(1610) & ChrW(1604) & ChrW(32) & ChrW(1578) & ChrW(1575) & ChrW(1585) & ChrW(1610) & ChrW(1582) & ChrW(32) & ChrW(1594) & ChrW(1610) & ChrW(1585) & _ ChrW(32) & ChrW(1589) & ChrW(1581) & ChrW(1610) & ChrW(1581) strTitle = ChrW(1600) & ChrW(1600) & ChrW(1600) & ChrW(1600) & ChrW(1600) & ChrW(1600) & ChrW(1607) & ChrW(124) & ChrW(67) & ChrW(97) & ChrW(117) & ChrW(116) & ChrW(105) & ChrW(111) & ChrW(110) & ChrW(124) & ChrW(1578) & ChrW(1606) & ChrW(1576) & ChrW(1610) & ChrW(1600) & ChrW(1600) & ChrW(1600) If (dtmNewDate >= dtmMaxStartDate) And (dtmNewDate <= dtmMaxEndDate) Then: MsgBox strMsg, vbOKOnly + vbMsgBoxRight, strTitle: Exit Sub Set db = CurrentDb Set rs = db.OpenRecordset("courses", dbOpenDynaset) With rs .AddNew !num = txtNo !namee = txtName !Cname = txtCname !Cstart = txtCstart !Cend = txtCend .Update End With Set rs = Nothing Set db = Nothing واخيرا المرفق دورات (3) .accdb 1 1
Foksh قام بنشر أكتوبر 9, 2023 قام بنشر أكتوبر 9, 2023 6 ساعات مضت, ابو جودي said: الشرح والمرفق مبدع كعادتك يا صديقي ؛ مع أني حديث المعرفة بالأساتذة والمبدعين ( دون حصر ) 😍
ابو جودي قام بنشر أكتوبر 9, 2023 قام بنشر أكتوبر 9, 2023 وجب التنويه الى شئ مهم وهى طريقة استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @ابوخليل والتى اعتمد استاذى ومعلمى الجليل فيها على حصر تاريخي البداية والنهاية بكل صراحة لم افهم الحكمة من ذلك وعلى اعتبار ان تاريخ اكبر اخر نهاية دورة هو الاساس وهو كان محور تركيزى واهتمامى فقط استحييت من اسأل استاذى على العام هنا ليس كبرا منى على العلم والله بل حياء منى و تقديرا وتبجيلا لمعلمى ظنا منى ان استاذى ومعلمى لم ينتبه الى هذه الجزئية وعلى الفور توجهت الى استاذى فى رسالة خاصة ولما تفضل بالرد على ازدت علما بجهلى فوجب التنويه الى ان بناء الكود بذلك الشكل هو الاصح 13 ساعات مضت, ابوخليل said: Private Sub Cstart_BeforeUpdate(Cancel As Integer) Dim Date1, Date2, tstDate As Date tstDate = Me.Cstart Date1 = DMax("[Cstart]", "courses", "[num] =" & Me.num) Date2 = DMax("[Cend]", "courses", "[num] =" & Me.num) If (tstDate >= Date1) And (tstDate <= Date2) Then Cancel = True: Me.Undo: MsgBox "nooooooooooo" End Sub وطبعا بعذ اذن استاذى الجليل ومعلمى القدير و والدى الحبيب بارك الله فيه انقل اليكم اقتباس ما دار بينى واستاذى لتعم الفائدة كان سؤالى على النحوى التالى 11 ساعات مضت, ابو جودي said: ما الحمكة أو الغرض من استخدام حضرتك لجلب آخر تاريخ البدء ثم آخر تاريخ النهاية وعمل الكود If (tstDate >= Date1) And (tstDate <= Date2) اذا كان تاريخ البدء الجديد للدورة الجديدة اكبر من او يساوى تاريخ اكبر تاريخ بدء للموظف كان أقل من أو يساوى اكبر آخر تاريخ نهاية للموظف بينما لو اكتفينا بالشق الثانى لحصلنا على نفس النتيجة If (tstDate <= Date2) وكانت اجابة استاذى الجليل ومعلمى القدير و والدى الحبيب 4 ساعات مضت, ابوخليل said: لا حرج لو وضعتها على العام لعموم الفائدة سأخبرك بالحكمة ولك الخيار في الاشارة اليها هناك من عدمه ، لضبطها لأنها بحاجة الى زيادة ضبط فأنا اعتقد بوجود ثغرة .. لو فرضنا ان الموظف تم تسجيل دورة له في شهر نوفمبر القادم تبدأ من 1 وحتى 10 من الشهر ولكن استجد امر يستلزم حضوره دورة اخرى في هذا الشهر تبدأ من 15 اكتوبر وحتى 20 منه على طريقتي سوف يقبل ( لأن الشرط محصور بين تاريخين معلومين ) الثغرة تظهر فيما لو تم تسجيل البداية مثلا في 25 اكتوبر والنهاية في 1 نوفمبر او ما بعده هنا سوف يقبل .. وهذا خطأ لانه مسجل في 1 وحتى 10 نوفمبر الحل هو عمل حدث آخر يخص تاريخ النهاية ولذلك تم تعديل المشاركة التى تحتوى على المرفق ببناء الكود الصحيح واعادى رفع المرفق كذلك على طريقة استاذى الجليل ومعلمى القدير و والدى الحبيب 1
ابوخليل قام بنشر أكتوبر 9, 2023 قام بنشر أكتوبر 9, 2023 شكرا لك استاذ محمد لنقلك الفائدة اعيد الحل مع معالجة احتمال التداخل او ما اسميتها بالثغرة Dim Date1, Date2, tstDate As Date Private Sub Cstart_BeforeUpdate(Cancel As Integer) tstDate = Me.Cstart Date1 = DMax("[Cstart]", "courses", "[num] =" & Me.num) Date2 = DMax("[Cend]", "courses", "[num] =" & Me.num) If (tstDate >= Date1) And (tstDate <= Date2) Then Cancel = True MsgBox "يوجد دورة مسجلة بهذا التاريخ " Me.Undo End If End Sub Private Sub Cend_BeforeUpdate(Cancel As Integer) If (Me.Cend >= Date1) Then Cancel = True MsgBox "يوجد دورة مسجلة بهذا التاريخ " Me.Undo End If End Sub دورات2.accdb 1
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.