عمل جدول مراقبة المعلمين تلقائي

محمد119900 · الخميس at 11:51

السلام عليكم

انشاء جدول يتم توزيعه تقائيا بمجرد إدخال المعلومات التالية في برنامج الاكسس

جدول بالاعمدة التالية

اسم المعلم /القاعة الامتحانية / فئة المعلم/ يوم المراقبة/ يوم امتحان مادة المعلم التي يدرسها / لجنة التصحيح

وأيضا ان يراعي الشروط التالية

الشرط الأول / ان يضع في كل قاعة معلم من فئة a, ومعلم من فئة b في نفس القاعة ونفس اليوم يعني كل قاعة فيها اثنين معلمين

الشرط الثاني / اذا كان للمعلم امتحان للمادة التي يدرسها لا يضعه بالمراقبة يعني اذا كان اسم المعلم في عمود ( يوم امتحان مادة المعلم التي يدرسها ) لا يضع بالمراقبة في نفس اليوم

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

تم تعديل الخميس at 12:29 بواسطه محمد119900

**ناقل** · الخميس at 15:10

3 ساعات مضت, محمد119900 said:

السلام عليكم

انشاء جدول يتم توزيعه تقائيا بمجرد إدخال المعلومات التالية في برنامج الاكسس

جدول بالاعمدة التالية

اسم المعلم /القاعة الامتحانية / فئة المعلم/ يوم المراقبة/ يوم امتحان مادة المعلم التي يدرسها / لجنة التصحيح

وأيضا ان يراعي الشروط التالية

الشرط الأول / ان يضع في كل قاعة معلم من فئة a, ومعلم من فئة b في نفس القاعة ونفس اليوم يعني كل قاعة فيها اثنين معلمين

الشرط الثاني / اذا كان للمعلم امتحان للمادة التي يدرسها لا يضعه بالمراقبة يعني اذا كان اسم المعلم في عمود ( يوم امتحان مادة المعلم التي يدرسها ) لا يضع بالمراقبة في نفس اليوم

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

اين بدايتك انت ... جداولك .... حتى نرى ما المطلوب ... ابدأ وسوف تجد الاجابات من مرتادي المنتدى ... ابشر

محمد119900 · الخميس at 16:35

1 ساعه مضت, ناقل said:

اين بدايتك انت ... جداولك .... حتى نرى ما المطلوب ... ابدأ وسوف تجد الاجابات من مرتادي المنتدى ... ابشر

والنعم منك استاذي

تقضل الملف مرفق

به جدول معلومات المعلمين

وبه جدول الخلاصة التي اريدها ان تضهر تلقائي

.........

ملاحظات إضافية

أحتاج مكان اكتب بها القاعات الامتحانية مثلا لدي 10 قاعات امتحانية

وكذلك أحتاج مكان اكتب به ايام المراقبة مثلا من السبت - الأحد - الاثنين- الثلاثاء - الأربعاء - الخميس

جدول مراقبة المعلمي.rar

تم تعديل الخميس at 16:41 بواسطه محمد119900

**ناقل** · الجمعة at 15:21

22 ساعات مضت, محمد119900 said:

تقضل الملف مرفق

به جدول معلومات المعلمين

وبه جدول الخلاصة التي اريدها ان تضهر تلقائي

ملاحظة القاعدة المرفقة لديك لم يتم التحميل ......

عملت لك قاعدة وفيها بيانات راجع جدول التوزيع هل تم بالشكل المطلوب ام لا ...............

NA_1.accdb

**ناقل** · الجمعة at 15:41

محمد119900 · الجمعة at 20:46

5 ساعات مضت, ناقل said:

ملاحظة القاعدة المرفقة لديك لم يتم التحميل ......

عملت لك قاعدة وفيها بيانات راجع جدول التوزيع هل تم بالشكل المطلوب ام لا ...............

NA_1.accdb 2.52 \u0645\u064a\u062c\u0627 \u0628\u0627\u064a\u062a · 3 downloads

بارك الله فيك استاذي الكريم أحتاج فقط إضافة شرطين

الشرط الأول / اذا كان للمعلم امتحان في تاريخ مثلا 1/6/2025 لا يتم وضعه في جدول المراقبة في هذا التاريخ مثلا 1/6/2025

الشرط الثاني / اذا كان للمعلم تاريخ تصحيح الدفاتر الامتحانية مثلا 5/6/2025

لا يتم وضعه في المراقبة في هذا التاريخ 5/6/2025

5 ساعات مضت, ناقل said:

عمل راقي

**ناقل** · الجمعة at 20:50

3 دقائق مضت, محمد119900 said:

بارك الله فيك استاذي الكريم أحتاج فقط إضافة شرطين

الشرط الأول / اذا كان للمعلم امتحان في تاريخ مثلا 1/6/2025 لا يتم وضعه في جدول المراقبة في هذا التاريخ مثلا 1/6/2025

الشرط الثاني / اذا كان للمعلم تاريخ تصحيح الدفاتر الامتحانية مثلا 5/6/2025

لا يتم وضعه في المراقبة في هذا التاريخ 5/6/2025

عمل راقي

هذه الشروط موجودة في الجدول المعلمين ... دقق في الصورة المرفقة

في علي احمد

و

منى عادل

جرب لاسماء من عندك ووزع ودقق في النتيجة

محمد119900 · الجمعة at 21:08

14 دقائق مضت, ناقل said:

هذه الشروط موجودة في الجدول المعلمين ... دقق في الصورة المرفقة

في علي احمد

و

منى عادل

جرب لاسماء من عندك ووزع ودقق في النتيجة

صراحة عمل يرفع له القبعه هل ممكن ولو تعبتك أنا تحويل الاعمدة بالعربي مثلا

اسم المعلم / تاريخ المراقبة / القاعات الامتحانية / فئة المعلم / تاريخ الامتحان مادة المعلم / تاريخ التصحيح

اذا ممكن

وهل هناك عداله بالمراقبة للمعلمين

**ناقل** · السبت at 02:49

5 ساعات مضت, محمد119900 said:

صراحة عمل يرفع له القبعه هل ممكن ولو تعبتك أنا تحويل الاعمدة بالعربي مثلا

اسم المعلم / تاريخ المراقبة / القاعات الامتحانية / فئة المعلم / تاريخ الامتحان مادة المعلم / تاريخ التصحيح

بالنسبة لاسماء الاعمدة . نعم ممكن تعديلها الى العربية .. سوف اشرح لك حال توفر جهاز حاسب لاني اكتب من الجوال

5 ساعات مضت, محمد119900 said:

وهل هناك عداله بالمراقبة للمعلمين

ما المقصود بالعدالة؟

أن يحصل كل معلم على عدد أيام مراقبة متقارب قدر الإمكان.
ألا يُكرر معلم في أكثر من يوم قبل استخدام باقي المعلمين.
أن يُوزع العبء بالتساوي بين الفئتين A و B.

محمد119900 · السبت at 04:14

منذ ساعه, ناقل said:

بالنسبة لاسماء الاعمدة . نعم ممكن تعديلها الى العربية .. سوف اشرح لك حال توفر جهاز حاسب لاني اكتب من الجوال

ما المقصود بالعدالة؟

أن يحصل كل معلم على عدد أيام مراقبة متقارب قدر الإمكان.

ألا يُكرر معلم في أكثر من يوم قبل استخدام باقي المعلمين.

أن يُوزع العبء بالتساوي بين الفئتين A و B.

نعم استاذي الكريم

**ناقل** · السبت at 14:24

17 ساعات مضت, محمد119900 said:

تحويل الاعمدة بالعربي مثلا

اسم المعلم / تاريخ المراقبة / القاعات الامتحانية / فئة المعلم / تاريخ الامتحان مادة المعلم / تاريخ التصحيح

بالنسبة للعربية انظر الصورة لتعديل اسماء التسمية التوضيحية للحقول

17 ساعات مضت, محمد119900 said:

عداله بالمراقبة للمعلمين

بالنسبة للعدالة طبعا تقريبية
اضف الحقل SupervisionCount في الجدول Teachers نمواصفت ( رقم - القيمة الافتراضية 0 )

ثم استخدم الكود التالي في زر التوزيع

    Dim db As DAO.Database
    Dim rsA As DAO.Recordset, rsB As DAO.Recordset
    Dim rsRooms As DAO.Recordset, rsDays As DAO.Recordset, rsTarget As DAO.Recordset
    Dim supervisionDate As Date, roomName As String
    Set db = CurrentDb()
    
' ? تمهيد: مسح الجدول وتصفير العدادات
db.Execute "UPDATE Teachers SET SupervisionCount = 0"
db.Execute "DELETE FROM TeacherAssignment"

    
    Set rsDays = db.OpenRecordset("SELECT * FROM SupervisionDays ORDER BY SupervisionDate", dbOpenDynaset)
    Set rsRooms = db.OpenRecordset("SELECT * FROM ExamRooms ORDER BY RoomName", dbOpenDynaset)
    Set rsTarget = db.OpenRecordset("TeacherAssignment")

    ' ? تحقق من توفر عدد كافٍ من المعلمين
    Dim totalSupervisionsNeeded As Long
    Dim availableA As Long, availableB As Long

    totalSupervisionsNeeded = DCount("*", "SupervisionDays") * DCount("*", "ExamRooms")

    availableA = DCount("*", "Teachers", "TeacherCategory = 'A' AND (ExamDate Is Null OR ExamDate Not In (SELECT SupervisionDate FROM SupervisionDays)) AND (CorrectionCommittee Is Null OR CorrectionCommittee = '')")
    availableB = DCount("*", "Teachers", "TeacherCategory = 'B' AND (ExamDate Is Null OR ExamDate Not In (SELECT SupervisionDate FROM SupervisionDays)) AND (CorrectionCommittee Is Null OR CorrectionCommittee = '')")

    If availableA < totalSupervisionsNeeded Or availableB < totalSupervisionsNeeded Then
    Dim response As VbMsgBoxResult
    response = MsgBox("عدد المعلمين المتاحين قد لا يكون كافياً لتغطية جميع القاعات في جميع الأيام." & vbCrLf & _
                      "هل ترغب في المتابعة مع ذلك؟", vbYesNo + vbQuestion, "تأكيد التوزيع")
    If response = vbNo Then
        MsgBox "تم إلغاء عملية التوزيع بناءً على طلب المستخدم.", vbInformation
        Exit Sub
    End If
   End If

    ' ?? بدء التوزيع
    Dim usedA As Collection: Set usedA = New Collection
    Dim usedB As Collection: Set usedB = New Collection

    Do While Not rsDays.EOF
        supervisionDate = rsDays!supervisionDate
        rsRooms.MoveFirst

        Do While Not rsRooms.EOF
            roomName = rsRooms!roomName

            ' معلم فئة A
            Set rsA = db.OpenRecordset("SELECT * FROM Teachers WHERE TeacherCategory='A' AND (CorrectionCommittee Is Null OR CorrectionCommittee='') ORDER BY SupervisionCount ASC", dbOpenSnapshot)
            rsA.MoveFirst
            Do While Not rsA.EOF
                If Not InCollection(usedA, rsA!TeacherName & "#" & supervisionDate) And (IsNull(rsA!ExamDate) Or rsA!ExamDate <> supervisionDate) Then
                    rsTarget.AddNew
                    rsTarget!TeacherName = rsA!TeacherName
                    rsTarget!TeacherCategory = rsA!TeacherCategory
                    rsTarget!ExamRoom = roomName
                    rsTarget!supervisionDate = supervisionDate
                    rsTarget.Update

                    On Error Resume Next
                    usedA.Add rsA!TeacherName, rsA!TeacherName & "#" & supervisionDate
                    Err.Clear: On Error GoTo 0

                    db.Execute "UPDATE Teachers SET SupervisionCount = SupervisionCount + 1 WHERE TeacherName = '" & rsA!TeacherName & "'"
                    Exit Do
                End If
                rsA.MoveNext
            Loop

            ' معلم فئة B
            Set rsB = db.OpenRecordset("SELECT * FROM Teachers WHERE TeacherCategory='B' AND (CorrectionCommittee Is Null OR CorrectionCommittee='') ORDER BY SupervisionCount ASC", dbOpenSnapshot)
            rsB.MoveFirst
            Do While Not rsB.EOF
                If Not InCollection(usedB, rsB!TeacherName & "#" & supervisionDate) And (IsNull(rsB!ExamDate) Or rsB!ExamDate <> supervisionDate) Then
                    rsTarget.AddNew
                    rsTarget!TeacherName = rsB!TeacherName
                    rsTarget!TeacherCategory = rsB!TeacherCategory
                    rsTarget!ExamRoom = roomName
                    rsTarget!supervisionDate = supervisionDate
                    rsTarget.Update

                    On Error Resume Next
                    usedB.Add rsB!TeacherName, rsB!TeacherName & "#" & supervisionDate
                    Err.Clear: On Error GoTo 0

                    db.Execute "UPDATE Teachers SET SupervisionCount = SupervisionCount + 1 WHERE TeacherName = '" & rsB!TeacherName & "'"
                    Exit Do
                End If
                rsB.MoveNext
            Loop

            rsRooms.MoveNext
        Loop

        rsDays.MoveNext
    Loop

    rsTarget.Close: rsA.Close: rsB.Close: rsRooms.Close: rsDays.Close
    Set rsTarget = Nothing: Set rsA = Nothing: Set rsB = Nothing
    Set rsRooms = Nothing: Set rsDays = Nothing: Set db = Nothing

    MsgBox "تم توزيع المعلمين بعد تحقق العدالة وشروط الاستبعاد!"

محمد119900 · السبت at 14:33

8 دقائق مضت, ناقل said:

بالنسبة للعربية انظر الصورة لتعديل اسماء التسمية التوضيحية للحقول

بالنسبة للعدالة طبعا تقريبية
اضف الحقل SupervisionCount في الجدول Teachers نمواصفت ( رقم - القيمة الافتراضية 0 )

ثم استخدم الكود التالي في زر التوزيع

    Dim db As DAO.Database
    Dim rsA As DAO.Recordset, rsB As DAO.Recordset
    Dim rsRooms As DAO.Recordset, rsDays As DAO.Recordset, rsTarget As DAO.Recordset
    Dim supervisionDate As Date, roomName As String
    Set db = CurrentDb()
    
' ? تمهيد: مسح الجدول وتصفير العدادات
db.Execute "UPDATE Teachers SET SupervisionCount = 0"
db.Execute "DELETE FROM TeacherAssignment"

    
    Set rsDays = db.OpenRecordset("SELECT * FROM SupervisionDays ORDER BY SupervisionDate", dbOpenDynaset)
    Set rsRooms = db.OpenRecordset("SELECT * FROM ExamRooms ORDER BY RoomName", dbOpenDynaset)
    Set rsTarget = db.OpenRecordset("TeacherAssignment")

    ' ? تحقق من توفر عدد كافٍ من المعلمين
    Dim totalSupervisionsNeeded As Long
    Dim availableA As Long, availableB As Long

    totalSupervisionsNeeded = DCount("*", "SupervisionDays") * DCount("*", "ExamRooms")

    availableA = DCount("*", "Teachers", "TeacherCategory = 'A' AND (ExamDate Is Null OR ExamDate Not In (SELECT SupervisionDate FROM SupervisionDays)) AND (CorrectionCommittee Is Null OR CorrectionCommittee = '')")
    availableB = DCount("*", "Teachers", "TeacherCategory = 'B' AND (ExamDate Is Null OR ExamDate Not In (SELECT SupervisionDate FROM SupervisionDays)) AND (CorrectionCommittee Is Null OR CorrectionCommittee = '')")

    If availableA < totalSupervisionsNeeded Or availableB < totalSupervisionsNeeded Then
    Dim response As VbMsgBoxResult
    response = MsgBox("عدد المعلمين المتاحين قد لا يكون كافياً لتغطية جميع القاعات في جميع الأيام." & vbCrLf & _
                      "هل ترغب في المتابعة مع ذلك؟", vbYesNo + vbQuestion, "تأكيد التوزيع")
    If response = vbNo Then
        MsgBox "تم إلغاء عملية التوزيع بناءً على طلب المستخدم.", vbInformation
        Exit Sub
    End If
   End If

    ' ?? بدء التوزيع
    Dim usedA As Collection: Set usedA = New Collection
    Dim usedB As Collection: Set usedB = New Collection

    Do While Not rsDays.EOF
        supervisionDate = rsDays!supervisionDate
        rsRooms.MoveFirst

        Do While Not rsRooms.EOF
            roomName = rsRooms!roomName

            ' معلم فئة A
            Set rsA = db.OpenRecordset("SELECT * FROM Teachers WHERE TeacherCategory='A' AND (CorrectionCommittee Is Null OR CorrectionCommittee='') ORDER BY SupervisionCount ASC", dbOpenSnapshot)
            rsA.MoveFirst
            Do While Not rsA.EOF
                If Not InCollection(usedA, rsA!TeacherName & "#" & supervisionDate) And (IsNull(rsA!ExamDate) Or rsA!ExamDate <> supervisionDate) Then
                    rsTarget.AddNew
                    rsTarget!TeacherName = rsA!TeacherName
                    rsTarget!TeacherCategory = rsA!TeacherCategory
                    rsTarget!ExamRoom = roomName
                    rsTarget!supervisionDate = supervisionDate
                    rsTarget.Update

                    On Error Resume Next
                    usedA.Add rsA!TeacherName, rsA!TeacherName & "#" & supervisionDate
                    Err.Clear: On Error GoTo 0

                    db.Execute "UPDATE Teachers SET SupervisionCount = SupervisionCount + 1 WHERE TeacherName = '" & rsA!TeacherName & "'"
                    Exit Do
                End If
                rsA.MoveNext
            Loop

            ' معلم فئة B
            Set rsB = db.OpenRecordset("SELECT * FROM Teachers WHERE TeacherCategory='B' AND (CorrectionCommittee Is Null OR CorrectionCommittee='') ORDER BY SupervisionCount ASC", dbOpenSnapshot)
            rsB.MoveFirst
            Do While Not rsB.EOF
                If Not InCollection(usedB, rsB!TeacherName & "#" & supervisionDate) And (IsNull(rsB!ExamDate) Or rsB!ExamDate <> supervisionDate) Then
                    rsTarget.AddNew
                    rsTarget!TeacherName = rsB!TeacherName
                    rsTarget!TeacherCategory = rsB!TeacherCategory
                    rsTarget!ExamRoom = roomName
                    rsTarget!supervisionDate = supervisionDate
                    rsTarget.Update

                    On Error Resume Next
                    usedB.Add rsB!TeacherName, rsB!TeacherName & "#" & supervisionDate
                    Err.Clear: On Error GoTo 0

                    db.Execute "UPDATE Teachers SET SupervisionCount = SupervisionCount + 1 WHERE TeacherName = '" & rsB!TeacherName & "'"
                    Exit Do
                End If
                rsB.MoveNext
            Loop

            rsRooms.MoveNext
        Loop

        rsDays.MoveNext
    Loop

    rsTarget.Close: rsA.Close: rsB.Close: rsRooms.Close: rsDays.Close
    Set rsTarget = Nothing: Set rsA = Nothing: Set rsB = Nothing
    Set rsRooms = Nothing: Set rsDays = Nothing: Set db = Nothing

    MsgBox "تم توزيع المعلمين بعد تحقق العدالة وشروط الاستبعاد!"

هل يمكن أن ترفق لي الملف

محمد119900 · السبت at 19:05

5 ساعات مضت, ناقل said:

بالنسبة للعربية انظر الصورة لتعديل اسماء التسمية التوضيحية للحقول

بالنسبة للعدالة طبعا تقريبية
اضف الحقل SupervisionCount في الجدول Teachers نمواصفت ( رقم - القيمة الافتراضية 0 )

ثم استخدم الكود التالي في زر التوزيع

    Dim db As DAO.Database
    Dim rsA As DAO.Recordset, rsB As DAO.Recordset
    Dim rsRooms As DAO.Recordset, rsDays As DAO.Recordset, rsTarget As DAO.Recordset
    Dim supervisionDate As Date, roomName As String
    Set db = CurrentDb()
    
' ? تمهيد: مسح الجدول وتصفير العدادات
db.Execute "UPDATE Teachers SET SupervisionCount = 0"
db.Execute "DELETE FROM TeacherAssignment"

    
    Set rsDays = db.OpenRecordset("SELECT * FROM SupervisionDays ORDER BY SupervisionDate", dbOpenDynaset)
    Set rsRooms = db.OpenRecordset("SELECT * FROM ExamRooms ORDER BY RoomName", dbOpenDynaset)
    Set rsTarget = db.OpenRecordset("TeacherAssignment")

    ' ? تحقق من توفر عدد كافٍ من المعلمين
    Dim totalSupervisionsNeeded As Long
    Dim availableA As Long, availableB As Long

    totalSupervisionsNeeded = DCount("*", "SupervisionDays") * DCount("*", "ExamRooms")

    availableA = DCount("*", "Teachers", "TeacherCategory = 'A' AND (ExamDate Is Null OR ExamDate Not In (SELECT SupervisionDate FROM SupervisionDays)) AND (CorrectionCommittee Is Null OR CorrectionCommittee = '')")
    availableB = DCount("*", "Teachers", "TeacherCategory = 'B' AND (ExamDate Is Null OR ExamDate Not In (SELECT SupervisionDate FROM SupervisionDays)) AND (CorrectionCommittee Is Null OR CorrectionCommittee = '')")

    If availableA < totalSupervisionsNeeded Or availableB < totalSupervisionsNeeded Then
    Dim response As VbMsgBoxResult
    response = MsgBox("عدد المعلمين المتاحين قد لا يكون كافياً لتغطية جميع القاعات في جميع الأيام." & vbCrLf & _
                      "هل ترغب في المتابعة مع ذلك؟", vbYesNo + vbQuestion, "تأكيد التوزيع")
    If response = vbNo Then
        MsgBox "تم إلغاء عملية التوزيع بناءً على طلب المستخدم.", vbInformation
        Exit Sub
    End If
   End If

    ' ?? بدء التوزيع
    Dim usedA As Collection: Set usedA = New Collection
    Dim usedB As Collection: Set usedB = New Collection

    Do While Not rsDays.EOF
        supervisionDate = rsDays!supervisionDate
        rsRooms.MoveFirst

        Do While Not rsRooms.EOF
            roomName = rsRooms!roomName

            ' معلم فئة A
            Set rsA = db.OpenRecordset("SELECT * FROM Teachers WHERE TeacherCategory='A' AND (CorrectionCommittee Is Null OR CorrectionCommittee='') ORDER BY SupervisionCount ASC", dbOpenSnapshot)
            rsA.MoveFirst
            Do While Not rsA.EOF
                If Not InCollection(usedA, rsA!TeacherName & "#" & supervisionDate) And (IsNull(rsA!ExamDate) Or rsA!ExamDate <> supervisionDate) Then
                    rsTarget.AddNew
                    rsTarget!TeacherName = rsA!TeacherName
                    rsTarget!TeacherCategory = rsA!TeacherCategory
                    rsTarget!ExamRoom = roomName
                    rsTarget!supervisionDate = supervisionDate
                    rsTarget.Update

                    On Error Resume Next
                    usedA.Add rsA!TeacherName, rsA!TeacherName & "#" & supervisionDate
                    Err.Clear: On Error GoTo 0

                    db.Execute "UPDATE Teachers SET SupervisionCount = SupervisionCount + 1 WHERE TeacherName = '" & rsA!TeacherName & "'"
                    Exit Do
                End If
                rsA.MoveNext
            Loop

            ' معلم فئة B
            Set rsB = db.OpenRecordset("SELECT * FROM Teachers WHERE TeacherCategory='B' AND (CorrectionCommittee Is Null OR CorrectionCommittee='') ORDER BY SupervisionCount ASC", dbOpenSnapshot)
            rsB.MoveFirst
            Do While Not rsB.EOF
                If Not InCollection(usedB, rsB!TeacherName & "#" & supervisionDate) And (IsNull(rsB!ExamDate) Or rsB!ExamDate <> supervisionDate) Then
                    rsTarget.AddNew
                    rsTarget!TeacherName = rsB!TeacherName
                    rsTarget!TeacherCategory = rsB!TeacherCategory
                    rsTarget!ExamRoom = roomName
                    rsTarget!supervisionDate = supervisionDate
                    rsTarget.Update

                    On Error Resume Next
                    usedB.Add rsB!TeacherName, rsB!TeacherName & "#" & supervisionDate
                    Err.Clear: On Error GoTo 0

                    db.Execute "UPDATE Teachers SET SupervisionCount = SupervisionCount + 1 WHERE TeacherName = '" & rsB!TeacherName & "'"
                    Exit Do
                End If
                rsB.MoveNext
            Loop

            rsRooms.MoveNext
        Loop

        rsDays.MoveNext
    Loop

    rsTarget.Close: rsA.Close: rsB.Close: rsRooms.Close: rsDays.Close
    Set rsTarget = Nothing: Set rsA = Nothing: Set rsB = Nothing
    Set rsRooms = Nothing: Set rsDays = Nothing: Set db = Nothing

    MsgBox "تم توزيع المعلمين بعد تحقق العدالة وشروط الاستبعاد!"

هل يمكن أن ترفق لي الملف

ضهرت لدي مشكلة تكرار مراقبة المعلم في نفس اليوم في أكثر من قاعة

مثل علي احمد

تم تعديل السبت at 19:42 بواسطه محمد119900

محمد119900 · السبت at 20:17

كيف احدد اذا كان للمعلم لجنة تصحيح

هل كتابة correction1

Correction2

Correction3

بهذا الترتيب

**ناقل** · منذ 9 ساعات

في 3‏/5‏/2025 at 22:05, محمد119900 said:

ضهرت لدي مشكلة تكرار مراقبة المعلم في نفس اليوم في أكثر من قاعة

تم تعديل الكود ............................

    Dim db As DAO.Database
    Dim rsA As DAO.Recordset, rsB As DAO.Recordset
    Dim rsRooms As DAO.Recordset, rsDays As DAO.Recordset, rsTarget As DAO.Recordset
    Dim supervisionDate As Date, roomName As String
    Dim teacherAssignedA As Boolean, teacherAssignedB As Boolean
    Dim dayKey As String
    Dim safeName As String
    Dim teacherName As String
    
    On Error GoTo ErrorHandler
    
    Set db = CurrentDb()
    
    ' 1. التهيئة: مسح الجدول وتصفير العدادات
    db.Execute "UPDATE Teachers SET SupervisionCount = 0"
    db.Execute "DELETE FROM TeacherAssignment"
    
    ' 2. التحقق من توفر عدد كافٍ من المعلمين
    Dim totalSupervisionsNeeded As Long
    Dim availableA As Long, availableB As Long
    Dim daysCount As Long, roomsCount As Long
    
    daysCount = DCount("*", "SupervisionDays")
    roomsCount = DCount("*", "ExamRooms")
    totalSupervisionsNeeded = daysCount * roomsCount ' معلم A ومعلم B لكل قاعة
    
    ' حساب المعلمين المتاحين مع مراعاة جميع شروط الاستثناء
    availableA = DCount("*", "Teachers", "TeacherCategory = 'A' " & _
                       "AND (ExamDate Is Null OR ExamDate Not In (SELECT SupervisionDate FROM SupervisionDays)) " & _
                       "AND (CorrectionCommittee Is Null OR CorrectionCommittee = '')")
    
    availableB = DCount("*", "Teachers", "TeacherCategory = 'B' " & _
                       "AND (ExamDate Is Null OR ExamDate Not In (SELECT SupervisionDate FROM SupervisionDays)) " & _
                       "AND (CorrectionCommittee Is Null OR CorrectionCommittee = '')")
    
    If availableA < totalSupervisionsNeeded Or availableB < totalSupervisionsNeeded Then
        Dim response As VbMsgBoxResult
        response = MsgBox("تحذير: عدد المعلمين غير كافي!" & vbCrLf & _
                         "المطلوب: " & totalSupervisionsNeeded & " معلم A و " & totalSupervisionsNeeded & " معلم B" & vbCrLf & _
                         "المتاح: " & availableA & " معلم A و " & availableB & " معلم B" & vbCrLf & _
                         "هل تريد المتابعة مع وضع 'غير مغطاة' للقاعات غير المكتملة؟", _
                         vbYesNo + vbExclamation, "تنبيه")
        If response = vbNo Then
            MsgBox "تم إلغاء التوزيع بناءً على طلبك.", vbInformation
            Exit Sub
        End If
    End If
    
    ' 3. بدء عملية التوزيع
    Set rsDays = db.OpenRecordset("SELECT * FROM SupervisionDays ORDER BY SupervisionDate", dbOpenDynaset)
    Set rsRooms = db.OpenRecordset("SELECT * FROM ExamRooms ORDER BY RoomName", dbOpenDynaset)
    Set rsTarget = db.OpenRecordset("TeacherAssignment")
    
    ' إنشاء قاموس لتتبع المعلمين في كل يوم على حدة
    Dim dailyTeachers As Object
    Set dailyTeachers = CreateObject("Scripting.Dictionary")
    
    ' حلقة على كل الأيام
    Do While Not rsDays.EOF
        supervisionDate = rsDays!supervisionDate
        
        ' تهيئة القاموس لهذا اليوم فقط (ليسمح بالتكرار في الأيام الأخرى)
        dailyTeachers.RemoveAll
        
        ' حلقة على كل القاعات
        rsRooms.MoveFirst
        Do While Not rsRooms.EOF
            roomName = rsRooms!roomName
            teacherAssignedA = False
            teacherAssignedB = False
            
            ' تعيين معلم فئة A
            Set rsA = db.OpenRecordset("SELECT * FROM Teachers WHERE TeacherCategory='A' " & _
                                     "AND (ExamDate Is Null OR ExamDate <> #" & Format(supervisionDate, "mm/dd/yyyy") & "#) " & _
                                     "AND (CorrectionCommittee Is Null OR CorrectionCommittee = '') " & _
                                     "ORDER BY SupervisionCount ASC", dbOpenDynaset)
            
            If Not rsA.EOF Then
                rsA.MoveFirst
                Do Until rsA.EOF Or teacherAssignedA
                    teacherName = rsA![teacherName]
                    If Not dailyTeachers.Exists(teacherName) Then
                        ' تعيين المعلم A
                        rsTarget.AddNew
                        rsTarget!teacherName = teacherName
                        rsTarget!TeacherCategory = "A"
                        rsTarget!ExamRoom = roomName
                        rsTarget!supervisionDate = supervisionDate
                        rsTarget.Update
                        
                        ' تحديث العداد
                        safeName = Replace(teacherName, "'", "''")
                        db.Execute "UPDATE Teachers SET SupervisionCount = SupervisionCount + 1 WHERE [TeacherName] = '" & safeName & "'"
                        
                        ' إضافة المعلم للقاموس اليومي فقط
                        dailyTeachers.Add teacherName, 1
                        teacherAssignedA = True
                    End If
                    rsA.MoveNext
                Loop
            End If
            rsA.Close
            
            ' إذا لم يتم تعيين معلم A، تسجيل "غير مغطاة"
            If Not teacherAssignedA Then
                rsTarget.AddNew
                rsTarget!teacherName = "غير مغطاة"
                rsTarget!TeacherCategory = "A"
                rsTarget!ExamRoom = roomName
                rsTarget!supervisionDate = supervisionDate
                rsTarget.Update
            End If
            
            ' تعيين معلم فئة B
            Set rsB = db.OpenRecordset("SELECT * FROM Teachers WHERE TeacherCategory='B' " & _
                                     "AND (ExamDate Is Null OR ExamDate <> #" & Format(supervisionDate, "mm/dd/yyyy") & "#) " & _
                                     "AND (CorrectionCommittee Is Null OR CorrectionCommittee = '') " & _
                                     "ORDER BY SupervisionCount ASC", dbOpenDynaset)
            
            If Not rsB.EOF Then
                rsB.MoveFirst
                Do Until rsB.EOF Or teacherAssignedB
                    teacherName = rsB![teacherName]
                    If Not dailyTeachers.Exists(teacherName) Then
                        ' تعيين المعلم B
                        rsTarget.AddNew
                        rsTarget!teacherName = teacherName
                        rsTarget!TeacherCategory = "B"
                        rsTarget!ExamRoom = roomName
                        rsTarget!supervisionDate = supervisionDate
                        rsTarget.Update
                        
                        ' تحديث العداد
                        safeName = Replace(teacherName, "'", "''")
                        db.Execute "UPDATE Teachers SET SupervisionCount = SupervisionCount + 1 WHERE [TeacherName] = '" & safeName & "'"
                        
                        ' إضافة المعلم للقاموس اليومي فقط
                        dailyTeachers.Add teacherName, 1
                        teacherAssignedB = True
                    End If
                    rsB.MoveNext
                Loop
            End If
            rsB.Close
            
            ' إذا لم يتم تعيين معلم B، تسجيل "غير مغطاة"
            If Not teacherAssignedB Then
                rsTarget.AddNew
                rsTarget!teacherName = "غير مغطاة"
                rsTarget!TeacherCategory = "B"
                rsTarget!ExamRoom = roomName
                rsTarget!supervisionDate = supervisionDate
                rsTarget.Update
            End If
            
            rsRooms.MoveNext
        Loop
        rsDays.MoveNext
    Loop
    
    ' 4. التنظيف وإغلاق الموارد
    rsTarget.Close
    rsRooms.Close
    rsDays.Close
    
    Set rsTarget = Nothing
    Set rsRooms = Nothing
    Set rsDays = Nothing
    Set rsA = Nothing
    Set rsB = Nothing
    Set db = Nothing
    Set dailyTeachers = Nothing
    
    MsgBox "تم الانتهاء من التوزيع بنجاح!" & vbCrLf & _
           "تم تعيين معلم A ومعلم B لكل قاعة" & vbCrLf & _
           "مع مراعاة الشروط التالية:" & vbCrLf & _
           "- عدم تكرار المعلم في نفس اليوم" & vbCrLf & _
           "- السماح بتكرار المعلم في أيام مختلفة" & vbCrLf & _
           "- استثناء المعلمين الذين لديهم اختبار في نفس اليوم" & vbCrLf & _
           "- استثناء المعلمين في لجان التصحيح" & vbCrLf & _
           "- العدالة في التوزيع حسب عدد المراقبات السابقة", _
           vbInformation, "إنجاز"
    Exit Sub

ErrorHandler:
    MsgBox "حدث خطأ أثناء التنفيذ: " & vbCrLf & _
           "رقم الخطأ: " & Err.Number & vbCrLf & _
           "الوصف: " & Err.Description & vbCrLf & _
           "في الإجراء: " & Erl, vbCritical, "خطأ"
    Resume Next

23 ساعات مضت, محمد119900 said:

كيف احدد اذا كان للمعلم لجنة تصحيح

هل كتابة correction1

اكتب اي عبارة حتى لو رقم المهم الا يكون الحقل فارغ ......

محمد119900 · منذ 9 ساعات

6 دقائق مضت, ناقل said:

تم تعديل الكود ............................

    Dim db As DAO.Database
    Dim rsA As DAO.Recordset, rsB As DAO.Recordset
    Dim rsRooms As DAO.Recordset, rsDays As DAO.Recordset, rsTarget As DAO.Recordset
    Dim supervisionDate As Date, roomName As String
    Dim teacherAssignedA As Boolean, teacherAssignedB As Boolean
    Dim dayKey As String
    Dim safeName As String
    Dim teacherName As String
    
    On Error GoTo ErrorHandler
    
    Set db = CurrentDb()
    
    ' 1. التهيئة: مسح الجدول وتصفير العدادات
    db.Execute "UPDATE Teachers SET SupervisionCount = 0"
    db.Execute "DELETE FROM TeacherAssignment"
    
    ' 2. التحقق من توفر عدد كافٍ من المعلمين
    Dim totalSupervisionsNeeded As Long
    Dim availableA As Long, availableB As Long
    Dim daysCount As Long, roomsCount As Long
    
    daysCount = DCount("*", "SupervisionDays")
    roomsCount = DCount("*", "ExamRooms")
    totalSupervisionsNeeded = daysCount * roomsCount ' معلم A ومعلم B لكل قاعة
    
    ' حساب المعلمين المتاحين مع مراعاة جميع شروط الاستثناء
    availableA = DCount("*", "Teachers", "TeacherCategory = 'A' " & _
                       "AND (ExamDate Is Null OR ExamDate Not In (SELECT SupervisionDate FROM SupervisionDays)) " & _
                       "AND (CorrectionCommittee Is Null OR CorrectionCommittee = '')")
    
    availableB = DCount("*", "Teachers", "TeacherCategory = 'B' " & _
                       "AND (ExamDate Is Null OR ExamDate Not In (SELECT SupervisionDate FROM SupervisionDays)) " & _
                       "AND (CorrectionCommittee Is Null OR CorrectionCommittee = '')")
    
    If availableA < totalSupervisionsNeeded Or availableB < totalSupervisionsNeeded Then
        Dim response As VbMsgBoxResult
        response = MsgBox("تحذير: عدد المعلمين غير كافي!" & vbCrLf & _
                         "المطلوب: " & totalSupervisionsNeeded & " معلم A و " & totalSupervisionsNeeded & " معلم B" & vbCrLf & _
                         "المتاح: " & availableA & " معلم A و " & availableB & " معلم B" & vbCrLf & _
                         "هل تريد المتابعة مع وضع 'غير مغطاة' للقاعات غير المكتملة؟", _
                         vbYesNo + vbExclamation, "تنبيه")
        If response = vbNo Then
            MsgBox "تم إلغاء التوزيع بناءً على طلبك.", vbInformation
            Exit Sub
        End If
    End If
    
    ' 3. بدء عملية التوزيع
    Set rsDays = db.OpenRecordset("SELECT * FROM SupervisionDays ORDER BY SupervisionDate", dbOpenDynaset)
    Set rsRooms = db.OpenRecordset("SELECT * FROM ExamRooms ORDER BY RoomName", dbOpenDynaset)
    Set rsTarget = db.OpenRecordset("TeacherAssignment")
    
    ' إنشاء قاموس لتتبع المعلمين في كل يوم على حدة
    Dim dailyTeachers As Object
    Set dailyTeachers = CreateObject("Scripting.Dictionary")
    
    ' حلقة على كل الأيام
    Do While Not rsDays.EOF
        supervisionDate = rsDays!supervisionDate
        
        ' تهيئة القاموس لهذا اليوم فقط (ليسمح بالتكرار في الأيام الأخرى)
        dailyTeachers.RemoveAll
        
        ' حلقة على كل القاعات
        rsRooms.MoveFirst
        Do While Not rsRooms.EOF
            roomName = rsRooms!roomName
            teacherAssignedA = False
            teacherAssignedB = False
            
            ' تعيين معلم فئة A
            Set rsA = db.OpenRecordset("SELECT * FROM Teachers WHERE TeacherCategory='A' " & _
                                     "AND (ExamDate Is Null OR ExamDate <> #" & Format(supervisionDate, "mm/dd/yyyy") & "#) " & _
                                     "AND (CorrectionCommittee Is Null OR CorrectionCommittee = '') " & _
                                     "ORDER BY SupervisionCount ASC", dbOpenDynaset)
            
            If Not rsA.EOF Then
                rsA.MoveFirst
                Do Until rsA.EOF Or teacherAssignedA
                    teacherName = rsA![teacherName]
                    If Not dailyTeachers.Exists(teacherName) Then
                        ' تعيين المعلم A
                        rsTarget.AddNew
                        rsTarget!teacherName = teacherName
                        rsTarget!TeacherCategory = "A"
                        rsTarget!ExamRoom = roomName
                        rsTarget!supervisionDate = supervisionDate
                        rsTarget.Update
                        
                        ' تحديث العداد
                        safeName = Replace(teacherName, "'", "''")
                        db.Execute "UPDATE Teachers SET SupervisionCount = SupervisionCount + 1 WHERE [TeacherName] = '" & safeName & "'"
                        
                        ' إضافة المعلم للقاموس اليومي فقط
                        dailyTeachers.Add teacherName, 1
                        teacherAssignedA = True
                    End If
                    rsA.MoveNext
                Loop
            End If
            rsA.Close
            
            ' إذا لم يتم تعيين معلم A، تسجيل "غير مغطاة"
            If Not teacherAssignedA Then
                rsTarget.AddNew
                rsTarget!teacherName = "غير مغطاة"
                rsTarget!TeacherCategory = "A"
                rsTarget!ExamRoom = roomName
                rsTarget!supervisionDate = supervisionDate
                rsTarget.Update
            End If
            
            ' تعيين معلم فئة B
            Set rsB = db.OpenRecordset("SELECT * FROM Teachers WHERE TeacherCategory='B' " & _
                                     "AND (ExamDate Is Null OR ExamDate <> #" & Format(supervisionDate, "mm/dd/yyyy") & "#) " & _
                                     "AND (CorrectionCommittee Is Null OR CorrectionCommittee = '') " & _
                                     "ORDER BY SupervisionCount ASC", dbOpenDynaset)
            
            If Not rsB.EOF Then
                rsB.MoveFirst
                Do Until rsB.EOF Or teacherAssignedB
                    teacherName = rsB![teacherName]
                    If Not dailyTeachers.Exists(teacherName) Then
                        ' تعيين المعلم B
                        rsTarget.AddNew
                        rsTarget!teacherName = teacherName
                        rsTarget!TeacherCategory = "B"
                        rsTarget!ExamRoom = roomName
                        rsTarget!supervisionDate = supervisionDate
                        rsTarget.Update
                        
                        ' تحديث العداد
                        safeName = Replace(teacherName, "'", "''")
                        db.Execute "UPDATE Teachers SET SupervisionCount = SupervisionCount + 1 WHERE [TeacherName] = '" & safeName & "'"
                        
                        ' إضافة المعلم للقاموس اليومي فقط
                        dailyTeachers.Add teacherName, 1
                        teacherAssignedB = True
                    End If
                    rsB.MoveNext
                Loop
            End If
            rsB.Close
            
            ' إذا لم يتم تعيين معلم B، تسجيل "غير مغطاة"
            If Not teacherAssignedB Then
                rsTarget.AddNew
                rsTarget!teacherName = "غير مغطاة"
                rsTarget!TeacherCategory = "B"
                rsTarget!ExamRoom = roomName
                rsTarget!supervisionDate = supervisionDate
                rsTarget.Update
            End If
            
            rsRooms.MoveNext
        Loop
        rsDays.MoveNext
    Loop
    
    ' 4. التنظيف وإغلاق الموارد
    rsTarget.Close
    rsRooms.Close
    rsDays.Close
    
    Set rsTarget = Nothing
    Set rsRooms = Nothing
    Set rsDays = Nothing
    Set rsA = Nothing
    Set rsB = Nothing
    Set db = Nothing
    Set dailyTeachers = Nothing
    
    MsgBox "تم الانتهاء من التوزيع بنجاح!" & vbCrLf & _
           "تم تعيين معلم A ومعلم B لكل قاعة" & vbCrLf & _
           "مع مراعاة الشروط التالية:" & vbCrLf & _
           "- عدم تكرار المعلم في نفس اليوم" & vbCrLf & _
           "- السماح بتكرار المعلم في أيام مختلفة" & vbCrLf & _
           "- استثناء المعلمين الذين لديهم اختبار في نفس اليوم" & vbCrLf & _
           "- استثناء المعلمين في لجان التصحيح" & vbCrLf & _
           "- العدالة في التوزيع حسب عدد المراقبات السابقة", _
           vbInformation, "إنجاز"
    Exit Sub

ErrorHandler:
    MsgBox "حدث خطأ أثناء التنفيذ: " & vbCrLf & _
           "رقم الخطأ: " & Err.Number & vbCrLf & _
           "الوصف: " & Err.Description & vbCrLf & _
           "في الإجراء: " & Erl, vbCritical, "خطأ"
    Resume Next

اكتب اي عبارة حتى لو رقم المهم الا يكون الحقل فارغ ......

ممكن الملف بدون زحمه على حضرتك وانا جدا ممتن وشاكر لحضرتك على مساعدتك ولطفك العالي وفي ميزان حسناتك ان شاء الله

لان اللغة العربية تضهر لي على شكل علامة استفهام في الكود وحاولت لكن ما ضبطت معي

تم تعديل منذ 8 ساعات بواسطه محمد119900

**ناقل** · منذ 8 ساعات

38 دقائق مضت, محمد119900 said:

ممكن الملف بدون زحمه على حضرتك

تفضل ......

‏‏NA_2.accdb

تسجيل الدخول

عمل جدول مراقبة المعلمين تلقائي

الردود الموصى بها

محمد119900

ناقل

محمد119900

ناقل

ناقل

محمد119900

ناقل

محمد119900

ناقل

ما المقصود بالعدالة؟

محمد119900

ما المقصود بالعدالة؟

ناقل

محمد119900

محمد119900

محمد119900

ناقل

محمد119900

ناقل

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information