Foksh

كما أشار بالتعديل الأستاذ خليفة ، استبدل الاستعلام التالي بالاستعلام الذي هو مصدر التقرير :- SELECT [استعلام اساسي التكليف].[رقم الموظف], [استعلام اساسي التكليف].[اسم الموظف], [استعلام اساسي التكليف].[رقم القسم], [استعلام اساسي التكليف].[اسم القسم], [استعلام اساسي التكليف].[رقم الموظف - التكليف], [استعلام اساسي التكليف].[تاريخ تسجيل التكليف], [استعلام اساسي التكليف].[مدة التكليف], [استعلام اساسي التكليف].[تاريخ التكليف], [استعلام اساسي التكليف].[ملاحظات التكليف], [استعلام اساسي التكليف].[رقم نوع التكيف], [استعلام اساسي التكليف].[التكليف - رقم نوع التكليف], [استعلام اساسي التكليف].[نوع التكليف], [استعلام اساسي التكليف].[المسمى الوظيفي], [استعلام اساسي التكليف].[اسم يوم التكليف], [استعلام اساسي التكليف].[اسم شهر التكليف], [استعلام اساسي التكليف].[الى تاريخ], [استعلام اساسي التكليف].[رقم صلاحية التشغيل], [استعلام اساسي التكليف].[نوع صلاحية التشغيل], [استعلام اساسي التكليف].[رقم شهر التكليف], [استعلام اساسي التكليف].[المسئول المباشر], [استعلام اساسي التكليف].[اسم المسئول], [استعلام اساسي التكليف].[سنة التكليف] FROM [استعلام اساسي التكليف] WHERE [استعلام اساسي التكليف].[رقم شهر التكليف] = [ادخل رقم شهر التكليف] AND [استعلام اساسي التكليف].[رقم الموظف] IN ( SELECT [رقم الموظف] FROM [استعلام اساسي التكليف] WHERE [رقم شهر التكليف] = [ادخل رقم شهر التكليف] GROUP BY [رقم الموظف] HAVING Count(*) > 10 ) ORDER BY [استعلام اساسي التكليف].[تاريخ التكليف];

وعليكم السلام ورحمة الله وبركاته .. لم يكن شرحك دقيقاً للطلوب ، ولكن كتجربة ، تابع نتيجة الإيستعلام التالي إن كانت هي المطلوبة أم لا .. SELECT التكليف.[رقم الموظف - التكليف] AS رقم_الموظف, التكليف.[تاريخ التكليف] FROM التكليف WHERE (((التكليف.[رقم الموظف - التكليف]) In (SELECT التكليف.[رقم الموظف - التكليف] FROM التكليف WHERE Month([تاريخ التكليف]) = [ادخل رقم الشهر] GROUP BY التكليف.[رقم الموظف - التكليف] HAVING Count(*) > 10 )) AND ((Month([تاريخ التكليف]))=[ادخل رقم الشهر])) ORDER BY التكليف.[رقم الموظف - التكليف]; * ملاحظاتي .. إن أردت النجاح في عملك ، ابتعد عن التسميات العربية لعناصر ومكونات مشروعك .

هل تقصد كهذه الفكرة ؟؟ لاحظ شريط التحرير والتنسيق في الصورة !!

وعليكم السلام ورحمة الله وبركاته.. تحقق من إعدادات اللغة العربية من خلال لوحة التحكم في الويندوز . راجع هذا الموضوع إذا كان إصدار الويندوز أحدث من ويندوز 7 .

أخي الفاضل @بلانك ، استخدم كلمات الإستعجال مثل "للرفع" أو "UP" ، مع الأخذ بعين الإعتبار إن من لديه مشاركة حل ، لن يبخل عليك بأي رد ، ولكن للظروف أحكام 😇 .

وعليكم السلام ورحمة الله وبركاته.. قد يفيدك هذا الموضوع بشكل كبير :-

نرجو منكم إغلاق الموضوع باختياركم "إختر تمت الإجابة" لإجابة الأستاذ @hegazee بما أنها قد حققت مطلبك بنجاح. 💐 وشكراً لمتابعتكم.

منا ومنكم صالح الأعمال والطاعات 💐

أهلاً بك أخي الحبيب @kanory ، سيتم إن شاء الله إضافة العديد من الميزات الى الفكرة قريباً. معلمنا الحبيب واستاذي وأخي جعفر .. سيتم طرح العمل بإذن الله تعالى قريباً في موضوع جديد بالإشارة الى هذا الموضوع ، ولكني انشغلت في سفري لأداء العُمرة الأولى لي في حياتي 😇 . فأشكر لكم ثقتكم ودعمكم . لذا أطلب من الجميع ان يسامحني إن تأخرت في طرح تجربتي .

أبدعت .. توظيف جميل واستغلال رائع للنموذج الفرعي بدلاً من الرسالة المزعجة فعلاً ..

ما رأيك بهذه الفكرة :- الملف مفتوح المصدر .. LblChanger - 1.zip

وعليكم السلام ورحمة الله وبركاته ،، جرب هذا التعديل الذي تم على الجمل الشرطية داخل الاستعلام عند التوزيع .. لجان الامتحانات.zip

بدايةً ما خطر ببالي كفكرة تتلخص في جدول واحد مخصص للتنفيذ ، ويحتوي الحقول التالية فرضاً .. حقل لاسم النموذج = نصي حقل لاسم الزر البرمجي = نصي حقل للتسمية القديمة = نصي حقل للتسمية الجديدة = نصي أيضاً حقل للتنفيذ = نعم / لا الآن الفكرة انه عند تحميل اي نموذج يتم تطبيق التسميات التي قام المستخدم بتحديدها وضبطها حسب حاجته من خلال نموذج يجلب أسماء الأزرار وتسميتها القديمة والجديدة لكل نموذج تم النقر على زر الإعدادات الخاص به . يعني بشكل مبسط .زر في كل نموذج مخصص لفتح نموذج ضبط التسميات ( إن صح التعبير ) . وهذا النموذج سيعرض التسميات القديمة والجديدة لكل زر في النموذج الحالي . انظر الصورة كفكرة توضيحية بعد تطبيقها . حيث لدي نموذجين Form1 & Form2 ، بهما العديد من الأزرار للتطبيق والتغذية البصرية . ويوجد زر ايقونته = الإعدادات ، لاحظ انه عند النقر على هذا الزر ماذا حصل !! سيتم تحميل جميع تسميات الأزرار في النموذج الحالي بدلاً من الاسم البرمجي للزر . لأن المستخدم العادي لن يميز اسمه البرمجي . فكان التوجه إلى إظهار التسميات للأزرار هو الأنسب . الآن وبعد السيطرة على الأزرار وتحديدها ، انظر للتجربة التالية بعد تغيير اسم مجموعة أزرار .. إذا كانت الفكرة مناسبة ، فسأقوم بطرح طريقة التطبيق في الرد التالي .. اعتقد أن الموقع والمنتدى قيد التحديث والتطوير ..

في بالي فكرة ، وسأحاول تطبيق مبدأها على نموذجين أو 3 ، للتوضيح ، ولكن اعطني بعض الوقت بحكم العمل .

وعليكم السلام ورحمة الله وبركاته .. اعتقد لو ان الحدث في غير النقر المزدوج ، سيكون أسهل على من يحاول . السبب باعتقادي ان النقرة الأولى ستكون لتنفيذ الحدث عند النقر !!!! هل توافقني الرأي ؟؟

بناءً على طلب أخي يوسف ، تم تحويل الكود إلى وحدة نمطية عامة ، بحيث يتم الاستدعاء من أي مكان وأي نموذج . بحيث تصبح :- Public Function GenerateSalary(yearInput As Integer) Dim db As DAO.Database Dim tDef As DAO.TableDef Dim fld As DAO.Field Dim rs As DAO.Recordset Dim startDate As Date, endDate As Date, d As Date Dim monthName As String Dim monthCode As Integer Dim shiftValue As Double Dim startDateTime As Date Dim endDateTime As Date Dim monthEndDate As Date Dim monthEndWorkDate As Date Dim m As Integer, y As Integer startDate = DateSerial(yearInput - 1, 12, 21) endDate = DateSerial(yearInput, 12, 20) On Error Resume Next DoCmd.DeleteObject acTable, "Salary" On Error GoTo 0 Set db = CurrentDb db.Execute "CREATE TABLE Salary (" & _ "ID AUTOINCREMENT PRIMARY KEY, " & _ "WorkDate DATE, " & _ "DayName TEXT(20), " & _ "MonthName TEXT(20), " & _ "monthCode LONG, " & _ "shift CURRENCY, " & _ "startDay DATE, " & _ "endDay DATE)" Set tDef = db.TableDefs("Salary") Set fld = tDef.Fields("shift") On Error Resume Next fld.Properties("Format") = "#,##0.00" If Err.Number <> 0 Then Err.Clear fld.Properties.Append fld.CreateProperty("Format", dbText, "#,##0.00") End If fld.Properties("DecimalPlaces") = 2 If Err.Number <> 0 Then Err.Clear fld.Properties.Append fld.CreateProperty("DecimalPlaces", dbInteger, 2) End If Set fld = tDef.Fields("startDay") On Error Resume Next fld.Properties("Format") = "hh:nn AM/PM" If Err.Number <> 0 Then Err.Clear fld.Properties.Append fld.CreateProperty("Format", dbText, "hh:nn AM/PM") End If Set fld = tDef.Fields("endDay") On Error Resume Next fld.Properties("Format") = "hh:nn AM/PM" If Err.Number <> 0 Then Err.Clear fld.Properties.Append fld.CreateProperty("Format", dbText, "hh:nn AM/PM") End If On Error GoTo 0 Set fld = Nothing Set tDef = Nothing Set rs = db.OpenRecordset("Salary", dbOpenDynaset) monthCode = 0 monthEndWorkDate = DateSerial(yearInput - 1, 12, 20) d = startDate Do While d <= endDate If Weekday(d, vbMonday) <> 5 And Weekday(d, vbMonday) <> 7 Then m = Month(d) y = Year(d) If Day(d) >= 21 Then m = m + 1 If m = 13 Then m = 1 y = y + 1 End If End If monthName = Format(DateSerial(y, m, 1), "MMMM") monthCode = 0 monthEndDate = DateSerial(Year(d), Month(d), 20) If Weekday(monthEndDate, vbMonday) = 5 Or Weekday(monthEndDate, vbMonday) = 7 Then monthEndWorkDate = monthEndDate Do monthEndWorkDate = DateAdd("d", -1, monthEndWorkDate) Loop Until Weekday(monthEndWorkDate, vbMonday) <> 5 And Weekday(monthEndWorkDate, vbMonday) <> 7 Else monthEndWorkDate = monthEndDate End If If d = monthEndWorkDate Then Select Case Month(d) Case 12: If Year(d) = yearInput - 1 Then monthCode = 1 Else monthCode = 12 Case 1: monthCode = 1 Case 2: monthCode = 2 Case 3: monthCode = 3 Case 4: monthCode = 4 Case 5: monthCode = 5 Case 6: monthCode = 6 Case 7: monthCode = 7 Case 8: monthCode = 8 Case 9: monthCode = 9 Case 10: monthCode = 10 Case 11: monthCode = 11 End Select End If If Weekday(d, vbMonday) = 6 Or Weekday(d, vbMonday) = 3 Then shiftValue = 1 startDateTime = DateAdd("n", 30, DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(8, 0, 0)) endDateTime = DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(13, 30, 0) Else shiftValue = 1.2 startDateTime = DateAdd("n", 10, DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(8, 0, 0)) endDateTime = DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(14, 30, 0) End If rs.AddNew rs!WorkDate = d rs!DayName = Format(d, "dddd") rs!monthName = monthName If monthCode > 0 Then rs!monthCode = monthCode Else rs!monthCode = Null End If rs!shift = shiftValue rs!startDay = startDateTime rs!endDay = endDateTime rs.Update End If d = d + 1 Loop rs.Close Set rs = Nothing db.TableDefs.Refresh Set db = Nothing MsgBox "تم إنشاء الجدول بنجاح", vbInformation + vbMsgBoxRight, "" DoCmd.SelectObject acTable, "Salary", True End Function طبعاً تم دمج الدالتين معاً . والإستغناء عن الإستدعاء المتكرر للجملة ElseIf باستخدام الدالة Select Case . وسيصبح الإستدعاء كمثال بالشكل التالي :- Private Sub btnGenerate_Click() If IsNull(Me.TxtYear) Then MsgBox "أدخل رقم السنة", vbExclamation + vbMsgBoxRight, "" Me.TxtYear.SetFocus Exit Sub End If GenerateSalary (Me.TxtYear) End Sub الملف بعد التعديل :- CalGen2.zip

😮 أين وجدت الحل ؟؟؟؟؟

الموضوع الحالي تم فتح النقاش فيه داخل الموضوع التالي :- لذا ، فضلاً وليس أمراً يمكنك استعجال المساعدة بكلمات مثل "للرفع" أو "Up" ، علك تجد حلاً لمشكلتك أخي طاهر . مغلق للتكرار في موضوع آخر غير منتهي .

أخي الفاضل ، لم لا تقوم بطرح جميع المطلوب كاملاً بدلاً من النقاط المبعثرة 😅 على العموم ، هذا التعديل لما طلبت ، تفضل ، استبدل الكود للزر بالتالي :- Private Sub btnGenerate_Click() Dim db As DAO.Database Dim tDef As DAO.TableDef Dim fld As DAO.Field Dim rs As DAO.Recordset Dim startDate As Date, endDate As Date, d As Date Dim yearInput As Integer Dim monthName As String Dim monthCode As Integer Dim shiftValue As Double Dim startDateTime As Date Dim endDateTime As Date Dim monthEndDate As Date Dim monthEndWorkDate As Date If IsNull(TxtYear) Then MsgBox "أدخل رقم السنة", vbExclamation + vbMsgBoxRight, "" Me.TxtYear.SetFocus Exit Sub End If yearInput = Me.TxtYear startDate = DateSerial(yearInput - 1, 12, 21) endDate = DateSerial(yearInput, 12, 20) On Error Resume Next DoCmd.DeleteObject acTable, "Salary" On Error GoTo 0 Set db = CurrentDb db.Execute "CREATE TABLE Salary (" & _ "ID AUTOINCREMENT PRIMARY KEY, " & _ "WorkDate DATE, " & _ "DayName TEXT(20), " & _ "MonthName TEXT(20), " & _ "monthCode LONG, " & _ "shift CURRENCY, " & _ "startDay DATE, " & _ "endDay DATE)" Set tDef = db.TableDefs("Salary") Set fld = tDef.Fields("shift") On Error Resume Next fld.Properties("Format") = "#,##0.00" If Err.Number <> 0 Then Err.Clear fld.Properties.Append fld.CreateProperty("Format", dbText, "#,##0.00") End If fld.Properties("DecimalPlaces") = 2 If Err.Number <> 0 Then Err.Clear fld.Properties.Append fld.CreateProperty("DecimalPlaces", dbInteger, 2) End If Set fld = tDef.Fields("startDay") On Error Resume Next fld.Properties("Format") = "hh:nn AM/PM" If Err.Number <> 0 Then Err.Clear fld.Properties.Append fld.CreateProperty("Format", dbText, "hh:nn AM/PM") End If Set fld = tDef.Fields("endDay") On Error Resume Next fld.Properties("Format") = "hh:nn AM/PM" If Err.Number <> 0 Then Err.Clear fld.Properties.Append fld.CreateProperty("Format", dbText, "hh:nn AM/PM") End If On Error GoTo 0 Set fld = Nothing Set tDef = Nothing Set rs = db.OpenRecordset("Salary", dbOpenDynaset) monthCode = 0 monthEndWorkDate = DateSerial(yearInput - 1, 12, 20) d = startDate Do While d <= endDate If Weekday(d, vbMonday) <> 5 And Weekday(d, vbMonday) <> 7 Then monthName = CustomMonth(d) monthCode = 0 monthEndDate = DateSerial(Year(d), Month(d), 20) If Weekday(monthEndDate, vbMonday) = 5 Or Weekday(monthEndDate, vbMonday) = 7 Then monthEndWorkDate = monthEndDate Do monthEndWorkDate = DateAdd("d", -1, monthEndWorkDate) Loop Until Weekday(monthEndWorkDate, vbMonday) <> 5 And Weekday(monthEndWorkDate, vbMonday) <> 7 Else monthEndWorkDate = monthEndDate End If If d = monthEndWorkDate Then If Month(d) = 12 And Year(d) = yearInput - 1 Then monthCode = 1 ElseIf Month(d) = 1 And Year(d) = yearInput Then monthCode = 1 ElseIf Month(d) = 2 Then monthCode = 2 ElseIf Month(d) = 3 Then monthCode = 3 ElseIf Month(d) = 4 Then monthCode = 4 ElseIf Month(d) = 5 Then monthCode = 5 ElseIf Month(d) = 6 Then monthCode = 6 ElseIf Month(d) = 7 Then monthCode = 7 ElseIf Month(d) = 8 Then monthCode = 8 ElseIf Month(d) = 9 Then monthCode = 9 ElseIf Month(d) = 10 Then monthCode = 10 ElseIf Month(d) = 11 Then monthCode = 11 ElseIf Month(d) = 12 Then monthCode = 12 End If End If If Weekday(d, vbMonday) = 6 Or Weekday(d, vbMonday) = 3 Then shiftValue = 1 startDateTime = DateAdd("n", 30, DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(8, 0, 0)) endDateTime = DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(13, 30, 0) Else shiftValue = 1.2 startDateTime = DateAdd("n", 10, DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(8, 0, 0)) endDateTime = DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(14, 30, 0) End If rs.AddNew rs!WorkDate = d rs!DayName = Format(d, "dddd") rs!monthName = monthName If monthCode > 0 Then rs!monthCode = monthCode Else rs!monthCode = Null End If rs!shift = shiftValue rs!startDay = startDateTime rs!endDay = endDateTime rs.Update End If d = d + 1 Loop rs.Close Set rs = Nothing db.TableDefs.Refresh Set db = Nothing MsgBox "تم إنشاء الجدول بنجاح", vbInformation + vbMsgBoxRight, "" DoCmd.SelectObject acTable, "Salary", True End Sub ملفك بعد التعديل :- CalGen.zip

هل تحققت من النتائج أستاذي العزيز

تفضل ، استبدل كود الزر القديم بالكود التالي ، مع بقاء الدالة في المديول كما هي .. Private Sub btnGenerate_Click() Dim db As DAO.Database Dim tDef As DAO.TableDef Dim fld As DAO.Field Dim rs As DAO.Recordset Dim startDate As Date, endDate As Date, d As Date Dim yearInput As Integer Dim monthName As String Dim monthCode As Integer Dim shiftValue As Double Dim startDateTime As Date Dim endDateTime As Date If IsNull(TxtYear) Then MsgBox "أدخل رقم السنة", vbExclamation + vbMsgBoxRight, "" Me.TxtYear.SetFocus Exit Sub End If yearInput = Me.TxtYear startDate = DateSerial(yearInput - 1, 12, 21) endDate = DateSerial(yearInput, 12, 20) On Error Resume Next DoCmd.DeleteObject acTable, "Salary" On Error GoTo 0 Set db = CurrentDb db.Execute "CREATE TABLE Salary (ID AUTOINCREMENT PRIMARY KEY, WorkDate DATE, DayName TEXT(20), MonthName TEXT(20), monthCode LONG, shift DOUBLE, startDay DATE, endDay DATE)" Set tDef = db.TableDefs("Salary") Set fld = tDef.Fields("shift") On Error Resume Next fld.Properties("Format") = "0.00" If Err.Number <> 0 Then Err.Clear fld.Properties.Append fld.CreateProperty("Format", dbText, "0.00") End If fld.Properties("DecimalPlaces") = 2 If Err.Number <> 0 Then Err.Clear fld.Properties.Append fld.CreateProperty("DecimalPlaces", dbInteger, 2) End If Set fld = tDef.Fields("startDay") On Error Resume Next fld.Properties("Format") = "hh:nn AM/PM" If Err.Number <> 0 Then Err.Clear fld.Properties.Append fld.CreateProperty("Format", dbText, "hh:nn AM/PM") End If Set fld = tDef.Fields("endDay") On Error Resume Next fld.Properties("Format") = "hh:nn AM/PM" If Err.Number <> 0 Then Err.Clear fld.Properties.Append fld.CreateProperty("Format", dbText, "hh:nn AM/PM") End If On Error GoTo 0 Set fld = Nothing Set tDef = Nothing Set rs = db.OpenRecordset("Salary", dbOpenDynaset) monthCode = 0 d = startDate Do While d <= endDate If Weekday(d, vbMonday) <> 5 And Weekday(d, vbMonday) <> 7 Then monthName = CustomMonth(d) monthCode = 0 If Month(d) = 12 And Day(d) = 20 And Year(d) = yearInput - 1 Then monthCode = 1 ElseIf Month(d) = 1 And Day(d) = 20 And Year(d) = yearInput Then monthCode = 1 ElseIf Month(d) = 2 And Day(d) = 20 Then monthCode = 2 ElseIf Month(d) = 3 And Day(d) = 20 Then monthCode = 3 ElseIf Month(d) = 4 And Day(d) = 20 Then monthCode = 4 ElseIf Month(d) = 5 And Day(d) = 20 Then monthCode = 5 ElseIf Month(d) = 6 And Day(d) = 20 Then monthCode = 6 ElseIf Month(d) = 7 And Day(d) = 20 Then monthCode = 7 ElseIf Month(d) = 8 And Day(d) = 20 Then monthCode = 8 ElseIf Month(d) = 9 And Day(d) = 20 Then monthCode = 9 ElseIf Month(d) = 10 And Day(d) = 20 Then monthCode = 10 ElseIf Month(d) = 11 And Day(d) = 20 Then monthCode = 11 ElseIf Month(d) = 12 And Day(d) = 20 Then monthCode = 12 End If If Weekday(d, vbMonday) = 7 Or Weekday(d, vbMonday) = 3 Then shiftValue = 1 startDateTime = DateAdd("n", 30, DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(8, 0, 0)) endDateTime = DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(13, 30, 0) Else shiftValue = 1.2 startDateTime = DateAdd("n", 10, DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(8, 0, 0)) endDateTime = DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(14, 30, 0) End If rs.AddNew rs!WorkDate = d rs!DayName = Format(d, "dddd") rs!monthName = monthName If monthCode > 0 Then rs!monthCode = monthCode Else rs!monthCode = Null End If rs!shift = shiftValue rs!startDay = startDateTime rs!endDay = endDateTime rs.Update End If d = d + 1 Loop rs.Close Set rs = Nothing db.TableDefs.Refresh Set db = Nothing MsgBox "تم إنشاء الجدول بنجاح", vbInformation + vbMsgBoxRight, "" DoCmd.SelectObject acTable, "Salary", True End Sub ملفك بعد التعديل :- CalGen.zip

للأسف أخي الكريم ، لا أعلم ما هو هذا البرنامج ,,

أخي @jo_2010 ، بدايةً ، وللإستفسار . هل الجدول هذا سيحتوي فقط على التواريخ التي تريدها للعام الذي ذكرته فقط !!!!!!! يعني لو حددنا التاريخ لسنة 2025 ، وتم انشاء التواريخ كما تريد ، ومن ثم حددنا تاريخ سنة 2026 ، فهل تريد ان يبقى العامين معاً ؟؟؟؟ إن كان جوابك لا .. فخطر ببالي فكرة تتجسد بالدالة الصغيرة التالية :- Public Function CustomMonth(d As Date) As String Dim m As Integer, y As Integer m = Month(d) y = Year(d) If Day(d) >= 21 Then m = m + 1 If m = 13 Then m = 1 y = y + 1 End If End If CustomMonth = Format(DateSerial(y, m, 1), "MMMM") End Function وفي نموذجك ننشئ مربع النص TxtYear سنحدد السنة ، ومن الزر BtnGenerate ، سيتم تنفيذ الفكرة التالية طبعاً بعد استبعاد يومي الجمعة و الأحد من الأيام المضافة لكل اشهر , :- Private Sub btnGenerate_Click() Dim db As DAO.Database Dim tDef As DAO.TableDef Dim rs As DAO.Recordset Dim startDate As Date, endDate As Date, d As Date Dim yearInput As Integer Dim monthName As String If IsNull(TxtYear) Then MsgBox "أدخل رقم السنة", vbExclamation + vbMsgBoxRight, "" Me.TxtYear.SetFocus Exit Sub End If yearInput = Me.TxtYear startDate = DateSerial(yearInput - 1, 12, 21) endDate = DateSerial(yearInput, 12, 20) On Error Resume Next DoCmd.DeleteObject acTable, "Salary" On Error GoTo 0 Set db = CurrentDb db.Execute "CREATE TABLE Salary (ID AUTOINCREMENT PRIMARY KEY, WorkDate DATE, DayName TEXT(20), MonthName TEXT(20))" Set rs = db.OpenRecordset("Salary", dbOpenDynaset) d = startDate Do While d <= endDate If Weekday(d, vbMonday) <> 5 And Weekday(d, vbMonday) <> 7 Then rs.AddNew rs!WorkDate = d rs!DayName = Format(d, "dddd") rs!monthName = CustomMonth(d) rs.Update End If d = d + 1 Loop rs.Close Set rs = Nothing Set db = Nothing MsgBox "تم إنشاء الجدول بنجاح", vbInformation + vbMsgBoxRight, "" DoCmd.SelectObject acTable, "Salary", True End Sub والفكرة تم تطبيقها على الملف التالي للتوضيح :- CalGen.zip

راجع هذا الموضوع :- أو هذا الموضوع أيضاً ..

تجسيداً لفكرة التعامل مع التقرير .. هذه الفكرة المبدأية لشكل التقرير عند فتحه بعد حفظ التصميم ، وتصديره الى ملف PDF .. مسارات ومواضع العناصر في الفيديو تم تجربتها مسبقاً . لذلك هي معروفة لي .