alsihran

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

تجربتي معاه جيد نظراً لعدم المامي الكامل بالمتغيرات والمصفوفات هو لازم تكون دقيق جدا في طرح السؤال والطلب حاول تشرح له كل كلمة بالتفصيل وانت صاحب باع طويل في هذا المجال اعتقد انك لو تسامحت معاه راح تفهمه ويفهمك 😁 لمى اغير في تعريف المتغير الممر الى الدالة Variant يظهر خطأ اخر ولمى اعمل العكس ايضا يظهر خطأ اخر 😇

السلام عليكم هذا الكود تم عمله عن طريق شات جي بي تي وهو يقوم بتوزيع طلاب على مدرسين مرتين بشرط عدم تكرار نفس الطالب مع المدرس في المرة الثانية وعدم وضع الطالب ونفس المدرس من نفس المجموعة Option Compare Database Option Explicit Dim assignedTeachers() As Variant ' Global array to track assigned teachers Sub DistributeStudentsToTeachers(callNumber As Integer) Dim db As DAO.Database Dim rstTeachers As DAO.Recordset Dim rstStudents As DAO.Recordset Dim rstLessons As DAO.Recordset Dim teacherCount As Integer Dim studentCount As Integer Dim teacherArray() As Variant Dim studentArray() As Variant Dim i As Integer Dim j As Integer Dim assigned As Boolean Dim minTeacherIndex As Integer Dim tempID As Variant Dim tempGroup As Variant Dim tempTimeEmp As Variant Set db = CurrentDb ' Open Teachers and Students tables Set rstTeachers = db.OpenRecordset("SELECT * FROM Tbl_Teachers") Set rstStudents = db.OpenRecordset("SELECT * FROM Tbl_Students") ' Count Teachers rstTeachers.MoveLast rstTeachers.MoveFirst teacherCount = rstTeachers.RecordCount ' Count Students rstStudents.MoveLast rstStudents.MoveFirst studentCount = rstStudents.RecordCount ' Verify there are Teachers and Students If teacherCount = 0 Or studentCount = 0 Then MsgBox "There are no teachers or students in the tables.", vbExclamation Exit Sub End If ' Store Teachers data in an array ReDim teacherArray(1 To teacherCount, 1 To 2) ' TeachersID, TeachersGroup i = 1 rstTeachers.MoveFirst Do Until rstTeachers.EOF teacherArray(i, 1) = rstTeachers!TeachersID teacherArray(i, 2) = rstTeachers!TeachersGroup i = i + 1 rstTeachers.MoveNext Loop ' Store Students data in an array ReDim studentArray(1 To studentCount, 1 To 3) ' StudentsID, StudentsGroup, TimeEmp i = 1 rstStudents.MoveFirst Do Until rstStudents.EOF studentArray(i, 1) = rstStudents!StudentsID studentArray(i, 2) = rstStudents!StudentsGroup studentArray(i, 3) = rstStudents!TimeEmp i = i + 1 rstStudents.MoveNext Loop ' Shuffle student array randomly Randomize For i = studentCount To 2 Step -1 j = Int((i - 1 + 1) * Rnd + 1) tempID = studentArray(i, 1) tempGroup = studentArray(i, 2) tempTimeEmp = studentArray(i, 3) studentArray(i, 1) = studentArray(j, 1) studentArray(i, 2) = studentArray(j, 2) studentArray(i, 3) = studentArray(j, 3) studentArray(j, 1) = tempID studentArray(j, 2) = tempGroup studentArray(j, 3) = tempTimeEmp Next i ' Open Lessons table for adding records Set rstLessons = db.OpenRecordset("Tbl_Lessons", dbOpenDynaset) ' Distribute students to teachers avoiding previous teacher For i = 1 To studentCount assigned = False ' Find available teachers (different group) excluding previously assigned teachers For j = 1 To teacherCount If studentArray(i, 2) <> teacherArray(j, 2) And Not IsTeacherAssigned(studentArray(i, 1), teacherArray(j, 1), callNumber) Then ' Assign the student to this teacher rstLessons.AddNew rstLessons!TeacherID = teacherArray(j, 1) rstLessons!StudentID = studentArray(i, 1) rstLessons!DateLessons = Date rstLessons!Call_Time = GenerateRandomTime(CInt(studentArray(i, 3))) rstLessons!Call_Number = callNumber rstLessons.Update ' Update assigned teachers list for this student and call number UpdateAssignedTeachers studentArray(i, 1), teacherArray(j, 1), callNumber assigned = True Exit For End If Next j ' If no suitable teacher found If Not assigned Then MsgBox "Cannot assign student " & studentArray(i, 1) & " to any available teacher due to group match or previous assignment.", vbExclamation End If Next i ' Close all Recordsets rstTeachers.Close rstStudents.Close rstLessons.Close Set rstTeachers = Nothing Set rstStudents = Nothing Set rstLessons = Nothing Set db = Nothing MsgBox "Students have been successfully distributed to teachers. Call_Number = " & callNumber End Sub ' Function to generate random time based on TimeEmp value Function GenerateRandomTime(timeEmp As Integer) As Date Dim randomTime As Date Select Case timeEmp Case 0 randomTime = #12:00:00 AM# Case 1 randomTime = TimeValue("08:00 AM") + Rnd * (TimeValue("02:00 PM") - TimeValue("08:00 AM")) Case 2 randomTime = TimeValue("08:00 AM") + Rnd * (TimeValue("04:00 PM") - TimeValue("08:00 AM")) Case 3 randomTime = TimeValue("09:00 AM") + Rnd * (TimeValue("05:00 PM") - TimeValue("09:00 AM")) Case 4 randomTime = TimeValue("11:00 AM") + Rnd * (TimeValue("05:00 PM") - TimeValue("11:00 AM")) Case Else randomTime = #12:00:00 AM# End Select GenerateRandomTime = randomTime End Function ' Function to check if a teacher is already assigned to a student in a given call number Function IsTeacherAssigned(studentID As Integer, teacherID As Integer, callNumber As Integer) As Boolean Dim i As Integer For i = LBound(assignedTeachers) To UBound(assignedTeachers) If assignedTeachers(i, 1) = studentID And assignedTeachers(i, 2) = teacherID And assignedTeachers(i, 3) = callNumber Then IsTeacherAssigned = True Exit Function End If Next i IsTeacherAssigned = False End Function ' Procedure to update assigned teachers for a student in a specific call number Sub UpdateAssignedTeachers(studentID As Integer, teacherID As Integer, callNumber As Integer) Dim nextIndex As Integer ' Find the next available index in assignedTeachers array nextIndex = IIf(IsEmpty(assignedTeachers), 1, UBound(assignedTeachers) + 1) ' Resize the array to accommodate new entry ReDim Preserve assignedTeachers(1 To nextIndex, 1 To 3) ' Add the assignment to the array assignedTeachers(nextIndex, 1) = studentID assignedTeachers(nextIndex, 2) = teacherID assignedTeachers(nextIndex, 3) = callNumber End Sub Sub Main() ' Initialize assignedTeachers array Erase assignedTeachers ' Distribute students with Call_Number = 1 DistributeStudentsToTeachers 1 ' Distribute students with Call_Number = 2 DistributeStudentsToTeachers 2 End Sub ويظهر الخطأ في هذا الجزء الموضح بالصورة ولم أعرف السبب ولم يتمكن الموقع المذكور من معرفة السبب صار يلف ويدور ويعطيني حلول ثانية لكن ما فيه فايده

وعليكم السلام ورحمة الله وبركاتة لم اعرف كيف اقوم بفتح الاكسس في الوضع الآمن هل المقصود اعادة تشغيل Windos في الوضع الآمن قمت بانشاء مستخدم جديد وظهرت نافذة الخصائص راجعت جميع الخطوات كل شيئ كان سليم وضبوط كنت على وشك اعادة تثبيت الوندوز من جديد ففكرت بأمر أن اقوم بتغيير لغة واجة الاكسس من اللغة العربية الى اللغة الانجليزية وهنا كانت المفاجئة بعد تحويل اللغة اصبح الكود يعمل يظهر النافذة ويخفيها وعند اعادة اللغة الى العربية لايعمل الكود الخلاصة أن الكود لايعمل مع هذا الاصدار من الاكسس مع اللغة العربية لا اعلم عن النسخ المختلفة هل يعمل ام لا شاكر ومقدر لك أخي سامي 🙏

وعليكم السلام ورحمة الله وبركاتة الله يعطيك العافية استاذ سامي جربت المرفق وللآسف لم يتم اظهار النافذة قمت بعملية اصلاح للبرنامج ولم تفلح وقمت بعملية الغاء التثبيت وتثبيته من جديد ايضا بدون فائدة لم يتبقى الا اعادة تثبيت نسخة الوندوز من جديد وهذا الأمر غير محبب ادناه صورة نسخة Microsofe

السلام عليكم عندي مشكلة عدم ظهور ورقة الخصائص للنموذج والاستعلامات والجداول بحث عن حل فوجدت الموضع التالي لكن للاسف لم تحل المشكلة جربت المرفق في الموضوع السابق وجدته يعمل على اصدار اكسس 2016 لكن لا يعمل على اكسس 2019 امل المساعده في ايجاد حل للمشكلة

السلام عليكم بالمرفق جدول بفت تيبل وضعت به مخطط زمني التواريخ بالجدول فقط لشهر يوليو وأغسطس بالمخطط الزمني تظهر جميع الشهور اريد ظهور شهر يوليو و أغسطس فقط في المخطط الزمني لآن هذه الشهور هي لتي لها بيانات بالجدول كذلك المخطط الزمني للأيام اريد ظهور تواريخ الايام الموجودة بالجدول المصنف1.xlsx

هذا هو المطلوب شكرا لك

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

السلام عليكم كيف يمكننا الحصول على الكود الذي يقوم بتصدير البيانات كما هو موضح بالصورة

اولا اشكرك من كل قلبي استاذنا الكريم لوقت وجهدك سواء توصلت للمطلوب ام لا فيكفي انك مددت لي يد المساعدة في ما يخص عدد الحصص تحسب بعدد الطلاب وليس بعدد المعلمين مثلا طلاب المجموعة A من مدينة الرياض عددهم 20 كل طالب 8 حصص وعدد المعلمين من خارج المدينة 5 سيتم توزيع الحصص عليهم يكون 100 حصة ولو كان هناك معلم في اجازة توزع حصصه على بقية المعلمين ثم نعود ونختار طلاب مدينة أخرى ونطبق عليها نفس المعايير انا هنا اشرح الفكرة فقط و لا اطلب منك المواصلة لاني اعرف تمام انك بذلت قصارى جهدك شكرا لك مرة اخرى

ايضاً استاذنا @ابوخليل لاحظت في عملك السابق أن عدد الحصص غير منتظم احياناً تجد 10حصص للطالب في الشهر وبعضهم 9 حصص واحيانا تجد الطلاب في بعض المجموعات تكون عدد الحصص 6 او 7 خلال الشهر يفترض ان يكون حصتين بالاسبوع بمعدل اقصى 8 حصص بالشهر لا تزيد ولا تنقص

اعتذر منك استاذنا ان الدروس تقدم عن بعد شاكر ومقدر لكم

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

جعلت تنسيق حقل التاريخ في الجداول والنموذج بهذا الشكل yyyy/mm/dd وما زالت المشكلة