عبدالله كاظم

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

وعليكم السلام ورحمة الله وبركاته جرب غير هذا السطر : With Application.FileDialog(4) بالتالي: With Application.FileDialog(1)

أستاذ @حمدى الظابط في نقطتين: 1- لما بكبس على توزيع آلي بهنق معاي الأكسس (الظاهر أن الاكسس بدخل لوب وما بيطلع منها)، في المرفق اللي أنت أرسلته وكما اللي أرسله الأستاذ خالد عبدالغفار. 2- المعذرة قاعد أحاول أفهم فكرة توزيع الجدول اللي أنت ما أستاذ @خالد عبد الغفار تشتغلوا عليها وماني قادر أفهمها فيا ريت يكون توضيح حق فكرة عمل المشروع وآلية التوزيع وبعدها إذا أقدر أساعد بالخدمة. مع فائق التحية

السلام عليكم ورحمة الله وبركاته الأخ @خالد عبد الغفار شوف التعديل في المرفق التالي ان شاء الله يكون هو المطلوب. بخصوص شرح الكود تفضل Private Function getAllPer() As Long 'يقوم بحساب مجموع الحصص الاسبوعية في الجدول بناء على البيانات في جدول [tblDays] Dim str As String Dim rst As Recordset str = "SELECT * FROM tblDays" Set rst = CurrentDb.OpenRecordset(str) If Not (rst.EOF) Then getAllPer = 0 rst.MoveFirst Do Until rst.EOF = True getAllPer = getAllPer + rst!NoOfClasses rst.MoveNext Loop End If End Function Private Function getAllTCCount() As Long 'يقوم بحساب مجموع انصبة جميع المعلمين من الحصص من جدول [tblTeachers] Dim str As String Dim rst As Recordset str = "SELECT * FROM tblTeachers" Set rst = CurrentDb.OpenRecordset(str) If Not (rst.EOF) Then getAllTCCount = 0 rst.MoveFirst Do Until rst.EOF = True getAllTCCount = getAllTCCount + rst!classCount rst.MoveNext Loop End If End Function 'هذا الفانكشن حق عمل رقم عشوائي بين رقمين ومو أنا الكاتبه Private Function GetRndNo(ByVal lLowerVal As Long, ByVal lUpperVal As Long, Optional bInclVals As Boolean = True) As Long On Error GoTo Error_Handler Dim lTmp As Long 'Swap the lLowerVal and lUpperVal values, if they were inversed in the originating ' function call If lLowerVal > lUpperVal Then lTmp = lLowerVal lLowerVal = lUpperVal lUpperVal = lTmp End If 'Adjust the boundary values should the user specify to exclude them from the ' possible returned values If bInclVals = False Then lLowerVal = lLowerVal + 1 lUpperVal = lUpperVal - 1 End If 'Calculate our random number! Randomize GetRndNo = Int((lUpperVal - lLowerVal + 1) * Rnd + lLowerVal) Error_Handler_Exit: On Error Resume Next Exit Function Error_Handler: 'LogError Err.Number, Err.Description, sModName & "\GetRndNo", , True, Erl MsgBox "The following error has occured" & vbCrLf & vbCrLf & _ "Error Number: " & Err.Number & vbCrLf & _ "Error Source: GetRndNo" & vbCrLf & _ "Error Description: " & Err.Description & _ Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _ , vbOKOnly + vbCritical, "An Error has Occured!" Resume Error_Handler_Exit End Function Private Sub test05() 'هنا يتم توزيع الجدول باستخدام جميع ما في الأعلى 'تعريف المتغيرات المستخدمه في الكود Dim strTeacher As String, strDay As String, strTimeTable Dim rstTeacher As Recordset, rstDay As Recordset, rstTimeTable As Recordset Dim randOFDays As Long Dim randOFDaysX As Long Dim TCount As Long Dim TCCount As Integer Dim dayC As Integer Dim xCls As String Dim toExit1 As Long 'هنا اختبار إذا تم ادخال بيانات أيام الاسبوع. إذا لا توجد سجلات يخرج من العملية If DCount("dayID", "tblDays") = 0 Then Exit Sub 'عمل استعلام للجدول [tblTeachers] strTeacher = "SELECT * FROM tblTeachers" Set rstTeacher = CurrentDb.OpenRecordset(strTeacher) 'الذهاب إلى السجل الأول في جدول المعلمين rstTeacher.MoveFirst TCount = 0 'اعطاء قيمة صفر للمتغير اللي يختبر عدد المعلمين بحيث يزيد مع كل دورة وهو عداد للمعلمين 'البدء في الدخول لوب للمعلمين، بمعني يدخل المعلم الأول ويوزع جدوله وبعدها ينتقل للمعلم الثاني... وهكذا 'بالامكان عمل لوب على المعلمين بطريقة ثانية Do TCCount = 0 'اعطاء قيمة صفر للمتغير اللي استخدمه لاختبار عدد حصص المعلم الحالي وهو عداد حصص المعلم line00: toExit = 0 'هذا المتغير استخدمه للأمان يمكن يكون في خطأ في البيانات المدخله ويدخل اللوب ولا يقدر يطلع منه. فهذا طوق نجاة:) dayC = 0 ' متغير لاختبار الأيام في اللوب التالي وهو عداد الأيام While dayC < DCount("dayID", "tblDays") 'بداية لوب الأيام بحث يعطي المعلم حصة في اليوم العشوائي الأول وبعدها حصة في ثاني إلى أن يكمل عدد الأيام line01: If TCCount = rstTeacher!classCount Then GoTo line02 ' هنا اختبار إذا قيمة المتغير تساوت مع عدد نصاب المعلم الحالي يروح إلى [line02] randOFDays = GetRndNo(1, DCount("dayID", "tblDays")) 'اختيار يوم عشوائي If randOFDays = randOFDaysX Then GoTo line01 'اختبار إذا كان اليوم العشوائي الأول يتساوي مع اليوم العشوائي الذي سيليه ينتقل [line01] randOFDaysX = randOFDays 'اسناد قيمة اليوم العشوائي إلى متغير يستخدم في الاختبار السابق 'هنا بداية تعبئة الجدول strDay = "SELECT * FROM tblDays" 'عمل استعلام لجدول الأيام Set rstDay = CurrentDb.OpenRecordset(strDay) rstDay.Move randOFDays - 1 'هنا يتم اختيار حصة عشوائية xCls = "cls" & GetRndNo(1, rstDay!NoOfClasses) 'هنا الاستعلام لجدول [TimeTable] بناء على اليوم المختار في السابق strTimeTable = "SELECT TimeTable.* FROM TimeTable WHERE (((TimeTable.theDay)=" & randOFDays & "));" Set rstTimeTable = CurrentDb.OpenRecordset(strTimeTable) 'اختبار أن الحصة المختارة عشوائياً في هذا اليوم لم يسجل فيها شيء If IsNull(rstTimeTable.Fields(xCls)) Then 'فإذا كانت فاضية يتم تحديثها ويدخل فيها اختصار المعلم CurrentDb.Execute "UPDATE TimeTable SET " & xCls & "= '" & rstTeacher!Shortcut & "' WHERE ((([theDay])=" & randOFDays & "));" TCCount = TCCount + 1 'زيادة واحد على عدد حصص المعلم Else toExit = toExit + 1 If toExit = 10000 Then Exit Sub 'إذا كانت الحصة غير فاضية يتم الرجوع إلى [line01] لإختيار حصة أخرى GoTo line01 End If dayC = dayC + 1 'هنا يتم زيادة واحد على قيمة عداد الأيام If TCCount < rstTeacher!classCount And dayC = DCount("dayID", "tblDays") Then GoTo line00 Wend line02: TCount = TCount + 1 'هنا يتم زيادة واحد على قيمة عداد المعلمين rstTeacher.MoveNext 'الانتقال للمعلم التالي Loop While TCount < DCount("teacherID", "tblTeachers") 'العودة للوب حتى ينتهي من جميع المعلمين End Sub Private Sub Command0_Click() CurrentDb.Execute "DELETE * FROM TimeTable" 'يقوم بحذف البيانات في جدول [tiemYable] CurrentDb.Execute "INSERT INTO TimeTable ( theDay ) SELECT dayID FROM tblDays;" 'يقوم باضافة أرقام الأيام في جدول [TimeTable] Me.subfrmTimeTable.Requery 'يقوم بعمل اعادة استعلام النموذج الفرعي [subfrmTimeTable] getAllPer 'استدعاء فانكشن حساب عدد الحصص الاسبوعية getAllTCCount 'استدعاء مجموع انصبة المعلمين If getAllTCCount > getAllPer Then 'اختبار إذا كان مجموع انصبة المعلمين أكبر من عدد الحصص الاسبوعية فيخرج من العملية MsgBox "عدد الحصص الأسبوعية أقل من مجموع أنصبة المعلمين!" Exit Sub Else test05 'استدعاء sub لعمل توزيع الجدول End If End Sub والمعذرة إذا كان الشرح غير جيد Database2_1.zip

العفو أستاذ @حمدى الظابط هو نسخة التجربة اللي في المثال السابق بدون جداول، هي كانت بس حق أجرب أعمل توزيع عشوائي لأنصبة المعلمين على حصص الاسبوع، بس تفضل في المرفق التالي طورت على المثال بحيث يكون مرتبط بجدول للمعلمين وعدد نصاب كل معلم، وجدول لأيام الأسبوع وعدد الحصص لكل يوم، وجدول يتم فيه تخزين الجدول بعد التوزيع. هي الفكرة كلها في التوزيع العشوائي، مع اني ودي بضوابط أكثر في التوزيع بس عندي مشروع ثاني محتاج أخلصه. مع فائق الاحترام والتقدير لك TimeTable1.accdb

و عليكم السلام ورحمة الله وبركاته أخوي @حمدى الظابط حاولت أفهم طبيعة المشروع حقك بس ما قدرت .. الظاهر التركيز حقي منخفض شوي 😅 على العموم :كنت بديت مشروع حق توزيع الجدول بس للتجربة ولا كملته لأني ملتزم بمشروع ثاني وماخذ وقت كبير مني هو بس تجربة للتوزيع العشوائي ممكن تستفيد منه TimeTable.accdb

ما يحتاج تحفظ المتبقي على العميل. اللي تحتاجه تعمل جمع للي دفعه العميل وتنقصه من القيمة الاجمالية. هذا والله أعلم شوف الملف التالي Customers.accdb

يعطيك العافية أخوي @kanory جهزت الملف أخوي @ابا جودى عافاك الله وكذلك أحبك في الله

العفو أخوي

بخصوص الموديول تفضل @ابا جودى هذي الفانكشن نحطها في كلاس Public Function getBackColor(DayName As String, repName As String) On Error Resume Next Dim rep As Report Dim chst As String Set rep = Reports(repName) Select Case DayName Case "السبت", "Saturday", "Sat" chst = Nz(DLookup("[Sa]", "tblDayColoer", acFirst), "16777215") rep.Detail.BackColor = chst Case "الاحد", "Sunday", "Sun " chst = Nz(DLookup("[Su]", "tblDayColoer", acFirst), "16777215") rep.Detail.BackColor = chst Case "الاثنين", "Monday", "Mon" chst = Nz(DLookup("[Mo]", "tblDayColoer", acFirst), "16777215") rep.Detail.BackColor = chst Case "الثلاثاء", "Tuesday", "Tue" chst = Nz(DLookup("[Tu]", "tblDayColoer", acFirst), "16777215") rep.Detail.BackColor = chst Case "الاربعاء", "Wednesday", "Wed" chst = Nz(DLookup("[We]", "tblDayColoer", acFirst), "16777215") rep.Detail.BackColor = chst Case "الخميس", "Thursday", "Thu" chst = Nz(DLookup("[Th]", "tblDayColoer", acFirst), "16777215") rep.Detail.BackColor = chst Case "الجمعه", "Friday", "Fri" chst = Nz(DLookup("[Fr]", "tblDayColoer", acFirst), "16777215") rep.Detail.BackColor = chst End Select End Function وهذا الكود نستخدمها في مع حدث On Format في التقرير Call getBackColor(Me.DayName, Me.Name)

غير خاصية Alternate Back Color إلى No Color

رائع أخوي @ابا جودى المرفق يعمل بشكل بدون مشاكل إما إذا كان قصدك في مرفق الأخ السائل فالـ Name حق Detail في في ملفه هو [تفاصيل] تقريبا

وعليكم السلام بعد اذن الأخ @kanory جرب الكود التالي في حدث On Load أو عند التحميل للتقرير Select Case Format(Date, "dddd") Case "Sunday" Me.مربع_خانة48.BackColor = RGB(156, 216, 255) Case "Monday" Me.مربع_خانة48.BackColor = RGB(214, 204, 172) Case "Tuesday" Me.مربع_خانة48.BackColor = RGB(214, 172, 213) Case "Wednesday" Me.مربع_خانة48.BackColor = RGB(172, 214, 173) Case "Thursday" Me.مربع_خانة48.BackColor = RGB(214, 175, 172) Case "Friday" Me.مربع_خانة48.BackColor = RGB(174, 172, 214) Case "Saturday" Me.مربع_خانة48.BackColor = RGB(244, 122, 237) End Select

وعليكم السلام تفضل booking.zip

الحمدلله والعفو اخوي