Foksh

ما رأيك بهذه الفكرة :- الملف مفتوح المصدر .. 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 .. مسارات ومواضع العناصر في الفيديو تم تجربتها مسبقاً . لذلك هي معروفة لي .