Des Alazee Aom

اخي 😭 انا الان في نفس موقفك وفي نفس المشروع اذا عند نسخة من المشروع او فكرة او اي شي يساعد انا محتاج مسا عدتك وشكرا اخوك من اليمن

يوجد لدي ثلاثة جداول الاطباء والمرضى والمواعيد باسم (Appointment) في اكسس 2016 جدول الاطباء يحتوي البيانات الاساسيه وايضا وقت الدوام والانتهاء ب الساعات مثلا من الساعه 8 ص الي 6 مساء وجدول المواعيد يجود فيه ساعه الموعد وتاريخ الموعد وقمت بإنشاء نموذج للموظفين ونموذج للمرضى واستعلام لجميع بيانات المواعيد والمرضى باسم (therapist_appointments) وقمت بعمل نموذج للمواعيد. بطريقه عرض عناصر متعددة بشرط تاريخ الموعد وزر للحذف وزر للطباعه باسم (Appointment) وقمت بإنشاء نموذج اخر للمواعيد بأسم therapist_FRMمصدر بياناته استعلام داخلي فيه من جدول الموظفين اسم ورقم الموظف ووقت البدايه والنهايه للدوام. وتم اضافة جميع عناصر الاستعلام الي النموذج therapist_FRM ومن اداه اختيار اسم طبيب والاداه باسم (Therapist_ID) بعدما يتم اختيار طبيب يوحد كود بعد التحديث لهذا الاداة وهو. Private Sub Therapist_id_AfterUpdate() Dim rs As Object Dim strcriteria As String strcriteria = InputBox("Enter Therapist ID") strcriteria = Me.Therapist_ID If strcriteria > "" Then Set rs = Me.RecordsetClone With rs.FindFirst "[Therapist_ID] like " & strcriteria & "* " If .NoMatch Then MsgBox "incorrect date, please enter the right ID for the Therapist", vbExclamation, "Not Found" Else Me.Bookmark = .Bookmark End If End With Set rs = Nothing End If Me.Therapist_ID.Enabled = False Me.Command51.Visible = True End Sub يتم اختيار تاريخ. وعند اختيار الوقت يقوم بعمل دوارة حسب بدايه ونهايه الدوام بعد اختيار الوقت يتم اضافة اسم الطبيب والتاريخ والوقت الي النموذج الفرعي Appointment وبعدها اختيار اسم المريض بعد الاختيار يقوم ب المقارنه اذا لم يوجد سجل مشابه في جدول المواعيد وبعدها قمت بإضافة النموذج المواعيد كنموذج فرعي . الذي اسمه (Appointment)الي نموذج therapist_FRM وايضا قمت بعمل مربع نص لاختيار التاريخ باسم (app_date) ومربع سرد وتحرير لاختيار. الوقت باسم (app_time) طبعا لايوجد لهم مصدر عنصر التحكم لمربع الوقت والتاريخ كود. عند الادخال في مربع تحرير وسرد لعرض الوقت هو Private Sub app_time_Enter() On Error Resume Next Dim i As Date, n As Integer, oRS As DAO.Recordset, sSQL As String Dim dLowerbreak As Date, dUpperBreak As Date, dDuration As Date Dim dLowerPrecision As Date, dUpperPrecision As Date app_time.RowSourceType = "Value List" app_time.RowSource = "" If IsNull(start) Then Exit Sub Else i = start If Me.NewRecord = True Then DoCmd.RunCommand acCmdSaveRecord End If sSQL = "SELECT Therapist_ID, Dateofsession, Timeofsession" sSQL = sSQL & " FROM therapist_appointments" sSQL = sSQL & " WHERE Therapist_ID= " & Me.Therapist_ID & _ " AND Dateofsession= #" & Me.app_date & "#" Set oRS = CurrentDb.OpenRecordset(sSQL) dDuration = TimeValue("00:30") dLowerbreak = txtEnd - TimeValue("00:00") Break is a field dUpperBreak = txtEnd + TimeValue("00:00") If oRS.RecordCount = 0 Then Do If i <= dLowerbreak Or i >= dUpperBreak Then app_time.AddItem i End If i = i + dDuration Loop Until i >= txtEnd Else Do If i <= dLowerbreak Or i >= dUpperBreak Then dLowerPrecision = i - TimeValue("00:00:05") dUpperPrecision = i + TimeValue("00:00:05") oRS.FindFirst "[Timeofsession] Between #" & dLowerPrecision & "# And #" & dUpperPrecision & "#" If oRS.NoMatch Then app_time.AddItem i End If i = i + dDuration Loop Until i >= txtEnd End If oRS.Close End Sub وكود بعد التحديث لنفس الاداء هو. Private Sub app_time_AfterUpdate() On Error Resume Next Me.Appointment.Locked = False Me.Appointment.Form!patient_ID.Locked = False Appointment.SetFocus DoCmd.GoToControl "Timeofsession" DoCmd.GoToRecord , , acNewRec Appointment.Form.Controls("Timeofsession") = Me.app_time Appointment.Form.Controls("dateofsession") = Me.app_date Appointment.Form.Controls("Patient_ID").SetFocus Appointment.Form.Controls("Patient_ID").Dropdown End Sub وقمت بعمل كود في النموذج المواعيد الفرعي (Appointment ) في اداة سرد وتحرير لاختيار اسم المريض والتي اسمها (Patient_ID) في حدث بعد التحديث يقوم بمقارنه الوقت التاريخ الجديد اذا لم يوجد سجل او سجلات مشابه للتاريخ والوقت يظهر ان الموعد محجوز الكود هو Private Sub Patient_ID_AfterUpdate() If DLookup("Dateofsession", "Appointment", "Timeofsession=" & Forms!therapist_frm.Form!Appointment!Timeofsession & "And Therapist_ID=" & Forms!therapist_frm.Form!Appointment!Therapist_ID & "") = Me.Dateofsession And DLookup("Patient_ID", "Appointment", "Timeofsession=" & Forms!therapist_frm.Form!Appointment!Timeofsession & "And Therapist_ID=" & Forms!therapist_frm.Form!Appointment!Therapist_ID & "") <> Me.patient_ID Then MsgBox "this time is taken", vbCritical, "Wrong time" DoCmd.SetWarnings False DoCmd.RunCommand acCmdDeleteRecord DoCmd.SetWarnings True Else MsgBox "Appointment saved" End If End Sub المشكله يمكن تكرار اكثر من موعد بنفس التاريخ والوقت https://drive.google.com/file/d/1HM3jw5uOuNxGyzwDEHqPkttLsCTeQlMv/view?usp=drivesdk

اخي نفس المشكله لاكن في اكسس2016