Foksh

الموضوع الحالي تم فتح النقاش فيه داخل الموضوع التالي :- لذا ، فضلاً وليس أمراً يمكنك استعجال المساعدة بكلمات مثل "للرفع" أو "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 Number, 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) = 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

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

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

وعليكم السلام ورحمة الله وبركاته.. باختصار ، دور آكسيس هو وسيط لفتح تطبيق الواتس أب لديك ، لذا لا أعتقد أنك تخترق سياسة استخدام التطبيق .

أخي @jo_2010 بما أن موضوع الحدث عند رسم النموذج يسبب مشكلة لديك ، دعنا نتوجه إلى الحل التالي . وهو إضافة بسيطة الى الاستعلام مصدر النموذج الفرعي ليصبح كالتالي :- SELECT Switch([External_lab] Is Null,Null,[External_lab]="",Null,[External_lab]="المختبر","Almokh",[External_lab]="البرج","1_AL_Borg",True,Null) AS DisplayImage, * FROM [Qry_Analysis collection]; بدلاً من القديم :- SELECT [Qry_Analysis collection].* FROM [Qry_Analysis collection]; وطبعاً سنحدد مصدر عنصر الصورة التي تريدها ليصبح الحقل الجديد = DisplayImage وبالتالي النتيجة بدون ترميش وتعتمد على مصدر النموذج الفرعي نفسه . والنتيجة في المرفق . تم تغيير اسم عنصر الصورة من Image ( وهو اسم محجوز لآكسيس وهو غير صحيح ) الى الاسم ImageFoksh . ومن الجدير بالذكر والتوضيح أنني اعتمدت على اسم الصورة المضمنة في قاعدة البيانات نفسها . JO_Lab3.zip

الفكرة لا تحتوي على اي أمر Refresh فعلي ، ولكن الحدث هذا مقرون بإعادة رسم النموذج ، لذا تأثيره يكون وكأنه تحديث للنموذج. لكن ما لم افهمه هو لماذا لا تستخدم الحل الأول بدلاً من تكرار الصورة كالمختبر مثلاً أو البرج لكل سجل !!!!

تفضل الملف بعد التطبق :- JO_Lab2.zip

تقصد كده كمثال ؟؟

تقصد كده .. طبعاً انا مش ملخبط بإن المكان يكون في المربع الأسود اللي انت اخترته ، ولكني طبقت الفكرة على الصور الأصلية بدلاً من تكرار الصور مرتين للمختبر أو البرج .

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

العفو أخي الكريم ، وحمداً لله إنك توجهت الى سبيل الحل .

سأحاول تثبيت الإصدار 2021 وتجربة الأداة ، ما لم يكن لأحد من الأخوة تجربة يفيدنا بها بهذا الإصدار . شكراً لاهتمامك ومتابعتك

فعلاً هذه الدالة كانت من أحد مشاريعي ، وتعرفت عليها مسبقاً ولكني شككت في نفسي هل فعلاً قمت بمشاركته أم لا سابقاً 😅 .. على العموم ، الحل الذي أفكر به أن أجعل الدالة ترجع String بدل Long للمتغير maxID . بمعنى أنه لا تقوم بتحويل الرقم التسلسلي الناتج إلى CLng بعد دمج النصوص (مكونات الرقم التسلسلي ) ، بل احتفظ به كنص . وعليه فبعد التعديل وإزالة التنسيق يصبح الكود كالتالي :- Public Function GenerateID(TableName As String, fieldName As String) As String Dim currentYear As Integer Dim yearPrefix As String Dim maxID As String Dim serialPart As Long currentYear = Year(Date) yearPrefix = currentYear & "" maxID = Nz(DMax(fieldName, TableName, fieldName & " LIKE '" & yearPrefix & "*'"), yearPrefix & "00") serialPart = CLng(Mid(maxID, Len(yearPrefix) + 1)) GenerateID = yearPrefix & "0000" & (serialPart + 1) End Function جربه وأخبرنا بالنتيجة

وعليكم السلام ورحمة الله وبركاته أخي الكريم .. مشاركة مع مهندسنا الغالي .. فكرتي تتلخص بالعمل على حدث On Paint لقسم التفاصيل . قم بإضافة مربع نص غير منضم ، ولا تحدد له لون خلفية أو لون حدود وسميه مثلاً FokshTXT ، و طبق ما يلي :- Private Sub تفصيل_Paint() If IsNull(Me.External_lab) Or Me.External_lab = "" Then Me.FokshTxT.BackStyle = 1 Me.FokshTxT.BackColor = RGB(255, 230, 250) Else Me.FokshTxT.BackStyle = 0 End If End Sub حيث وللتوضيح ، اللون [RGB(255, 230, 250)] هو لون الخلفية المستخدم في النموذج . فقط تحكمنا بتلوين خلفية مربع النص ، كما في الصورة التالية :- وملفك بعد التعديل :- JO_Lab.zip

وعليكم السلام ورحمة الله وبركاته .. جرب هذا التعديل أخل الكريم .. DCOUNT.zip

هذه تجربتي المباشرة على الإصدار الحديث Version 2.3000.1031261430.258708 . أحدث من إصدارك حتى ، مع العلم أن إصدارك تمت التجربة عليه سابقاً ( التطبيق موجود ضمن المشاركات ) .. انظر هذا التصوير :-

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

أخي بلال ، وعليكم السلام ورحمة الله وبركاته .. أرجو منك ان تأخذ الأمر على محمل الجد بضرورة ارفاق ملف وتوضح في الشرح مطلبك بشكل دقيق للمطلوب . تم تنبيهك مرة ، متأملاً منك وأنت عضو فضي ان تلتزم بسياسة وقوانين المنتدى شكراً لك وكل الشكر للأستاذ @kkhalifa1960 ، على ما يقدمه من حلول تساهم في حل مشاكل واستفسارات وطلبات الأخوة

جرب هذا الملف بعد أخذ جميع الإحتمالات :- dcount.zip

مشاركة مع معلمي الفاضل ، ومن باب التوضيح ( ما لم أكن قد فهمت بشكل خاطئ ) ، اعتقد انه يجب تضمين شرط جديد للتعداد بحيث يخص رقم الحالة فقط ( حقل معرف ) على ما اعتقد