ابو جودي

ولا يهمك ده مرفقك بعد التعديل تدلل بيانات المدرسين (1).zip

تجرب ورايا تصدق زعلتنى يا راجل دا شغل فاخر من الاخر ايه اللى انت بتقوله ده هو انت شايفنى بنى ادم طبيعى واللا عاقل عل كل حال تم تغير الوظيفه : GetRetirementInfo بالوظيفة الجديده التاليه ' دالة لحساب تفاصيل التقاعد بناءً على تاريخ الميلاد ' الغرض: تحديد سن التقاعد، تاريخ التقاعد، والوقت المتبقي (سنوات، أشهر، أيام) ' المعاملات: ' - birthDate (Variant): تاريخ الميلاد (مطلوب) ' - showDetails (Boolean, اختياري): إذا كان True، يتم إرجاع التفاصيل الكاملة، وإذا كان False يتم إرجاع تاريخ التقاعد فقط ' الإرجاع: سلسلة نصية تحتوي على نتائج الحسابات أو رسالة خطأ إذا كان المدخل غير صالح Public Function GetRetirementInfo(birthDate As Date, Optional showDetails As Boolean = False) As String Dim retirementAge As Integer ' سن التقاعد Dim RetirementDate As Date ' تاريخ التقاعد Dim remainingYears As Integer ' السنوات المتبقية Dim remainingMonths As Integer ' الأشهر المتبقية Dim remainingDays As Integer ' الأيام المتبقية Dim result As String ' النتيجة النهائية Dim currentDate As Date ' التاريخ الحالي Dim tempDate As Date ' تاريخ مؤقت Dim adjustmentDays As Integer ' تعديل الأيام ' تعيين قيمة التعديل adjustmentDays = -1 ' طرح يوم واحد من تاريخ التقاعد ' التحقق من صحة تاريخ الميلاد If IsNull(birthDate) Or Not IsDate(birthDate) Then result = "" Else birthDate = CDate(birthDate) ' تحديد سن التقاعد بناءً على تاريخ الميلاد If birthDate < DateSerial(1971, 7, 1) Then retirementAge = 60 ElseIf birthDate < DateSerial(1972, 7, 1) Then retirementAge = 61 ElseIf birthDate < DateSerial(1973, 7, 1) Then retirementAge = 62 ElseIf birthDate < DateSerial(1974, 7, 1) Then retirementAge = 63 ElseIf birthDate < DateSerial(1975, 7, 1) Then retirementAge = 64 Else retirementAge = 65 End If ' حساب تاريخ التقاعد RetirementDate = DateAdd("yyyy", retirementAge, birthDate) ' إضافة سن التقاعد RetirementDate = DateAdd("d", adjustmentDays, RetirementDate) ' تطبيق التعديل ' إذا طُلبت التفاصيل If showDetails Then currentDate = Date remainingYears = DateDiff("yyyy", currentDate, RetirementDate) tempDate = DateAdd("yyyy", remainingYears, currentDate) If tempDate > RetirementDate Then remainingYears = remainingYears - 1 tempDate = DateAdd("yyyy", remainingYears, currentDate) End If remainingMonths = 0 While DateAdd("m", 1, tempDate) <= RetirementDate remainingMonths = remainingMonths + 1 tempDate = DateAdd("m", 1, tempDate) Wend remainingDays = DateDiff("d", tempDate, RetirementDate) result = "تاريخ الميلاد: " & birthDate & vbCrLf & _ "سن التقاعد: " & retirementAge & vbCrLf & _ "تاريخ التقاعد: " & RetirementDate & vbCrLf & _ "السنوات المتبقية: " & remainingYears & vbCrLf & _ "الأشهر المتبقية: " & remainingMonths & vbCrLf & _ "الأيام المتبقية: " & remainingDays Else result = "تاريخ التقاعد: " & RetirementDate End If End If GetRetirementInfo = result End Function من يريد خصم اليوم يستخدم المتغير التالى ' تعيين قيمة التعديل adjustmentDays = -1 ' طرح يوم واحد من تاريخ التقاعد ومن لا يريد خصم يوم يستخدم المتغير بالشكل التالى ' تعيين قيمة التعديل adjustmentDays = 0 ' طرح يوم واحد من تاريخ التقاعد وده المرفق سن التقاعد (6).accdb

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

سبحانك لا علم لنا الا ما علمتنا انك انت الحكيم العليم كل الفضل والشكر لله سبحانه وتعالى الذى هدانا وما كنا لنهتدى لو لا ان هدانا الله عزوجل هذا فضل الله ثم اساتذتنا العظماء الذين نتعلم منهم وعلى اياديهم انا مجرد سبب فقط لا اكثر من ذلك و لا اقل اعتقد والله اعلم أن 7/1 هو الصحيح اولا هو الموجود فى ملف الاكسل المرفق للاستاذ @Lotfy14 ثانيا شهر 7 هو بداية العام المالى الجديد لذلك هو اوقع من شهر 1 من وجهة نظرى المتواضعة ثالثا عندما أبحث على الانترنت لا اعتمد الا النتائج من المصادر الموثوقة مثل الدستور مثلا وهاكم رابط المصدر الذى استندت اليه https://www.dostor.org/4831633 واخيرا اجابتى فى هذه النقطه مجرد اجتهاد شخصى قد أخطى وقد أصيب لذلك من يهتم يتأكد من المعلومات الصحيحة من جانبه

انتم احد اهم ركائز المنتدى واحد اعظم الاساتذة الذين يتعلم منهم كل طلاب العلم وانا أول هؤلاء الطلاب وفى مقدمتهم ولا نظن بكم الا كل الخيــــــر

بل أنا من يسعده ذلك بل واتشوق الى ذلك فكما تعلم أنت ملهمى ودائما تكمل ما ينقص أفكارى

طيب اولا شكرا على افكارك يا استاذ فؤش افندى وسعيد جدا جدا جدا بمشاركة حضرتك ثانيا اعتذر ان المشاركة أتت بعدك ولكن انا تقريبا بدأت كتابة المشاركة وتعديل الكود بالتطويرات الجديده تقريبا من الساعه 11: 45 تقريبا ولو لاحظت هتلاقينى ذكرت فى المشاركة فطبعا اعتذر ان جائت المشاركة بعد مشاركتك دون الاشارة اليكم فيها انت وضعت المشاركه وانا منشغل فى التنسيق وتطوير الكود وتعديل المشاركة اثناء تطوير الكود والرد والمشاركة فى نفس الوقت على موضع أخر فى المنتدى فى نفس الوقت وطبعا لو اردنا النتائج فى مرفقى المتواضع تظهر بشكل مباشر مع تغيير السجلات يمكن فقط ان يكون الكود التالى فى حدث الحالى للنموذج Private Sub Form_Current() Call btnCalculateGetInfo_Click End Sub حتى ولو كان مصدر بيانات النموذج هو الجدول مباشرة دون الاعتماد على الاستعلام كما قدمته انا كما فى هذا المرفق الاخيــــــــــــــــــــــر * ملاحظة انا عدلت الكود لتمرير اسم مربع النص كعنصر تحكم فى هذا المرفق بدلا من تمريره كنص سلسلة نصية تمت التوصيه من وجهة نظرى المتواضعة بهذا الكود النهائى فى هذا المرفق الشامل والوافى الاكواد النهائية بعد التطوير فى الوحده النمطية لحساب سن التقاعد Option Compare Database Option Explicit '------------------------------------------------------------ ' وحدة لحساب سن التقاعد والوقت المتبقي حتى التقاعد ' تحتوي على دالتين رئيسيتين: ' 1. GetRetirementInfo: لحساب تفاصيل التقاعد وإرجاعها كسلسلة نصية ' 2. PopulateRetirementFields: لتوزيع النتائج على مربعات نصوص في نموذج '------------------------------------------------------------ ' دالة لحساب تفاصيل التقاعد بناءً على تاريخ الميلاد ' الغرض: تحديد سن التقاعد، تاريخ التقاعد، والوقت المتبقي (سنوات، أشهر، أيام) ' المعاملات: ' - birthDate (Variant): تاريخ الميلاد (مطلوب) ' - showDetails (Boolean, اختياري): إذا كان True، يتم إرجاع التفاصيل الكاملة، وإذا كان False يتم إرجاع تاريخ التقاعد فقط ' الإرجاع: سلسلة نصية تحتوي على نتائج الحسابات أو رسالة خطأ إذا كان المدخل غير صالح Public Function GetRetirementInfo(birthDate As Variant, Optional showDetails As Boolean = False) As String Dim retirementAge As Integer ' متغير لتخزين سن التقاعد Dim RetirementDate As Date ' متغير لتخزين تاريخ التقاعد Dim remainingYears As Integer ' متغير لتخزين السنوات المتبقية حتى التقاعد Dim remainingMonths As Integer ' متغير لتخزين الأشهر المتبقية حتى التقاعد Dim remainingDays As Integer ' متغير لتخزين الأيام المتبقية حتى التقاعد Dim result As String ' متغير لتخزين النتيجة النهائية كسلسلة نصية Dim currentDate As Date ' متغير لتخزين التاريخ الحالي Dim tempDate As Date ' متغير مؤقت للمساعدة في الحسابات التدريجية ' التحقق من صحة تاريخ الميلاد If IsNull(birthDate) Or Not IsDate(birthDate) Then result = "" ' إرجاع رسالة خطأ إذا كان التاريخ فارغًا أو غير صالح Else birthDate = CDate(birthDate) ' تحويل المدخل إلى تاريخ ' تحديد سن التقاعد بناءً على تاريخ الميلاد وفقًا للقواعد المحددة If birthDate < DateSerial(1971, 7, 1) Then retirementAge = 60 ElseIf birthDate < DateSerial(1972, 7, 1) Then retirementAge = 61 ElseIf birthDate < DateSerial(1973, 7, 1) Then retirementAge = 62 ElseIf birthDate < DateSerial(1974, 7, 1) Then retirementAge = 63 ElseIf birthDate < DateSerial(1975, 7, 1) Then retirementAge = 64 Else retirementAge = 65 End If ' حساب تاريخ التقاعد بإضافة سن التقاعد إلى تاريخ الميلاد RetirementDate = DateAdd("yyyy", retirementAge, birthDate) ' إذا تم طلب التفاصيل الكاملة If showDetails Then currentDate = Date ' تعيين التاريخ الحالي ' حساب السنوات المتبقية باستخدام الفرق بين التاريخ الحالي وتاريخ التقاعد remainingYears = DateDiff("yyyy", currentDate, RetirementDate) tempDate = DateAdd("yyyy", remainingYears, currentDate) ' تصحيح السنوات إذا تجاوز التاريخ المؤقت تاريخ التقاعد If tempDate > RetirementDate Then remainingYears = remainingYears - 1 tempDate = DateAdd("yyyy", remainingYears, currentDate) End If ' حساب الأشهر المتبقية تدريجيًا remainingMonths = 0 While DateAdd("m", 1, tempDate) <= RetirementDate remainingMonths = remainingMonths + 1 tempDate = DateAdd("m", 1, tempDate) Wend ' حساب الأيام المتبقية باستخدام الفرق بين التاريخ المؤقت وتاريخ التقاعد remainingDays = DateDiff("d", tempDate, RetirementDate) ' تجميع النتيجة كسلسلة نصية تحتوي على جميع التفاصيل result = "تاريخ الميلاد: " & birthDate & vbCrLf & _ "سن التقاعد: " & retirementAge & vbCrLf & _ "تاريخ التقاعد: " & RetirementDate & vbCrLf & _ "السنوات المتبقية: " & remainingYears & vbCrLf & _ "الأشهر المتبقية: " & remainingMonths & vbCrLf & _ "الأيام المتبقية: " & remainingDays Else ' إرجاع تاريخ التقاعد فقط إذا لم يتم طلب التفاصيل result = "تاريخ التقاعد: " & RetirementDate End If End If GetRetirementInfo = result ' إرجاع النتيجة النهائية End Function ' إجراء لتوزيع تفاصيل التقاعد على مربعات نصوص في نموذج ' الغرض: أخذ نتائج GetRetirementInfo وتعيينها في مربعات نصوص منفصلة أو مربع نص واحد ' المعاملات: ' - frm (Form): النموذج الذي يحتوي على مربعات النصوص ' - birthDate (Variant): تاريخ الميلاد (مطلوب) ' - txtBirthDate, txtRetirementAge, txtRetirementDate, txtRemainingYears, ' txtRemainingMonths, txtRemainingDays (TextBox, اختياري): كائنات مربعات النصوص للقيم المنفصلة ' - txtAllDetails (TextBox, اختياري): كائن مربع النص لعرض السلسلة الكاملة Public Sub PopulateRetirementFields(frm As Form, birthDate As Variant, _ Optional txtBirthDate As TextBox, Optional txtRetirementAge As TextBox, _ Optional txtRetirementDate As TextBox, Optional txtRemainingYears As TextBox, _ Optional txtRemainingMonths As TextBox, Optional txtRemainingDays As TextBox, _ Optional txtAllDetails As TextBox) Dim result As String ' متغير لتخزين النتيجة من GetRetirementInfo Dim lines() As String ' مصفوفة لتقسيم السلسلة إلى أسطر Dim i As Integer ' متغير للحلقة ' تفريغ جميع مربعات النصوص الممررة أولاً On Error Resume Next ' تجاهل الأخطاء إذا لم يتم تمرير المربع If Not txtAllDetails Is Nothing Then txtAllDetails.Value = "" If Not txtBirthDate Is Nothing Then txtBirthDate.Value = "" If Not txtRetirementAge Is Nothing Then txtRetirementAge.Value = "" If Not txtRetirementDate Is Nothing Then txtRetirementDate.Value = "" If Not txtRemainingYears Is Nothing Then txtRemainingYears.Value = "" If Not txtRemainingMonths Is Nothing Then txtRemainingMonths.Value = "" If Not txtRemainingDays Is Nothing Then txtRemainingDays.Value = "" On Error GoTo 0 ' التحقق من تاريخ الميلاد ومعالجته فقط إذا كان صالحًا If Not IsNull(birthDate) And IsDate(birthDate) Then ' استدعاء دالة GetRetirementInfo مع طلب التفاصيل الكاملة result = GetRetirementInfo(birthDate, True) ' التحقق مما إذا كانت النتيجة تحتوي على خطأ If result = "يرجى إدخال تاريخ ميلاد صالح" Then ' إذا كان هناك خطأ، تبقى الحقول فارغة (تم تفريغها مسبقًا) Else ' إذا تم تمرير txtAllDetails، اعرض السلسلة الكاملة فيه If Not txtAllDetails Is Nothing Then txtAllDetails.Value = result End If ' تقسيم السلسلة إلى أسطر لتعيين القيم في مربعات النصوص المنفصلة lines = Split(result, vbCrLf) For i = LBound(lines) To UBound(lines) On Error Resume Next ' تجاهل الأخطاء إذا لم يتم تمرير المربع If InStr(lines(i), "تاريخ الميلاد: ") > 0 And Not txtBirthDate Is Nothing Then txtBirthDate.Value = Mid(lines(i), InStr(lines(i), ": ") + 2) ElseIf InStr(lines(i), "سن التقاعد: ") > 0 And Not txtRetirementAge Is Nothing Then txtRetirementAge.Value = Mid(lines(i), InStr(lines(i), ": ") + 2) ElseIf InStr(lines(i), "تاريخ التقاعد: ") > 0 And Not txtRetirementDate Is Nothing Then txtRetirementDate.Value = Mid(lines(i), InStr(lines(i), ": ") + 2) ElseIf InStr(lines(i), "السنوات المتبقية: ") > 0 And Not txtRemainingYears Is Nothing Then txtRemainingYears.Value = Mid(lines(i), InStr(lines(i), ": ") + 2) ElseIf InStr(lines(i), "الأشهر المتبقية: ") > 0 And Not txtRemainingMonths Is Nothing Then txtRemainingMonths.Value = Mid(lines(i), InStr(lines(i), ": ") + 2) ElseIf InStr(lines(i), "الأيام المتبقية: ") > 0 And Not txtRemainingDays Is Nothing Then txtRemainingDays.Value = Mid(lines(i), InStr(lines(i), ": ") + 2) End If On Error GoTo 0 Next i End If End If End Sub ' إجراء لعرض تعليمات حول استخدام وحدة سن التقاعد ' الغرض: تقديم إرشادات بسيطة للمستخدم حول كيفية استخدام الدوال Public Sub ShowRetirementHelp() Dim helpMessage As String helpMessage = "تعليمات استخدام وحدة سن التقاعد:" & vbCrLf & vbCrLf & _ "1. GetRetirementInfo(birthDate, [showDetails]):" & vbCrLf & _ " - birthDate: تاريخ الميلاد (مطلوب، مثال: '2/19/1980')" & vbCrLf & _ " - showDetails: اختياري (True للحصول على التفاصيل الكاملة، False لتاريخ التقاعد فقط)" & vbCrLf & _ " - الإرجاع: سلسلة نصية تحتوي على تاريخ التقاعد أو التفاصيل الكاملة" & vbCrLf & vbCrLf & _ "2. PopulateRetirementFields(frm, birthDate, [txtBirthDate], [txtRetirementAge], " & _ "[txtRetirementDate], [txtRemainingYears], [txtRemainingMonths], [txtRemainingDays], [txtAllDetails]):" & vbCrLf & _ " - frm: النموذج الحالي (مطلوب)" & vbCrLf & _ " - birthDate: تاريخ الميلاد (مطلوب)" & vbCrLf & _ " - txtBirthDate إلخ: كائنات مربعات النصوص لعرض القيم المنفصلة (اختياري، مثال: Me.txtBirth)" & vbCrLf & _ " - txtAllDetails: كائن مربع النص لعرض السلسلة الكاملة (اختياري، مثال: Me.txtRetirementDetails)" & vbCrLf & _ " - مثال: PopulateRetirementFields Me, Me.TEmp_BirthDate, Me.txtBirth, Me.txtRetAge, Me.txtRetirement, " & _ "Me.txtYearsLeft, Me.txtMonthsLeft, Me.txtDaysLeft, Me.txtRetirementDetails" & vbCrLf & vbCrLf & _ "ملاحظات: إذا لم يتم تمرير كائن مربع نص، يتم تجاهله دون إيقاف التنفيذ." MsgBox helpMessage, vbInformation, "تعليمات وحدة سن التقاعد" End Sub الاكواد النهائية بعد التطوير فى الوحده النمطية لحساب العمر Option Compare Database Option Explicit '------------------------------------------------------------ ' وحدة لحساب العمر بدقة بناءً على تاريخ الميلاد ' تحتوي على دالتين رئيسيتين: ' 1. GetAgeInfo: لحساب العمر (سنوات، أشهر، أيام) وإرجاعه كسلسلة نصية ' 2. PopulateAgeFields: لتوزيع النتائج على مربعات نصوص في نموذج '------------------------------------------------------------ ' دالة لحساب العمر بدقة بناءً على تاريخ الميلاد ' الغرض: تحديد العمر بالسنوات والأشهر والأيام من تاريخ الميلاد إلى التاريخ الحالي ' المعاملات: ' - birthDate (Variant): تاريخ الميلاد (مطلوب) ' الإرجاع: سلسلة نصية تحتوي على العمر أو رسالة خطأ إذا كان المدخل غير صالح Public Function GetAgeInfo(birthDate As Variant) As String Dim ageYears As Integer ' متغير لتخزين عدد السنوات في العمر Dim ageMonths As Integer ' متغير لتخزين عدد الأشهر في العمر Dim ageDays As Integer ' متغير لتخزين عدد الأيام في العمر Dim currentDate As Date ' متغير لتخزين التاريخ الحالي Dim tempDate As Date ' متغير مؤقت للمساعدة في الحسابات التدريجية Dim result As String ' متغير لتخزين النتيجة النهائية كسلسلة نصية ' التحقق من صحة تاريخ الميلاد If IsNull(birthDate) Or Not IsDate(birthDate) Then result = "يرجى إدخال تاريخ ميلاد صالح" ' إرجاع رسالة خطأ إذا كان التاريخ فارغًا أو غير صالح Else birthDate = CDate(birthDate) ' تحويل المدخل إلى تاريخ currentDate = Date ' تعيين التاريخ الحالي ' التأكد من أن تاريخ الميلاد قبل التاريخ الحالي If birthDate > currentDate Then result = "تاريخ الميلاد يجب أن يكون قبل التاريخ الحالي" ' رسالة خطأ إذا كان التاريخ مستقبليًا Else ' حساب السنوات باستخدام الفرق بين تاريخ الميلاد والتاريخ الحالي ageYears = DateDiff("yyyy", birthDate, currentDate) tempDate = DateAdd("yyyy", ageYears, birthDate) ' تصحيح السنوات إذا تجاوز التاريخ المؤقت التاريخ الحالي If tempDate > currentDate Then ageYears = ageYears - 1 tempDate = DateAdd("yyyy", ageYears, birthDate) End If ' حساب الأشهر تدريجيًا ageMonths = 0 While DateAdd("m", 1, tempDate) <= currentDate ageMonths = ageMonths + 1 tempDate = DateAdd("m", 1, tempDate) Wend ' حساب الأيام باستخدام الفرق بين التاريخ المؤقت والتاريخ الحالي ageDays = DateDiff("d", tempDate, currentDate) ' تجميع النتيجة كسلسلة نصية تحتوي على تفاصيل العمر result = "تاريخ الميلاد: " & birthDate & vbCrLf & _ "السنوات: " & ageYears & vbCrLf & _ "الأشهر: " & ageMonths & vbCrLf & _ "الأيام: " & ageDays End If End If GetAgeInfo = result ' إرجاع النتيجة النهائية End Function ' إجراء لتوزيع تفاصيل العمر على مربعات نصوص في نموذج ' الغرض: أخذ نتائج GetAgeInfo وتعيينها في مربعات نصوص منفصلة ' المعاملات: ' - frm (Form): النموذج الذي يحتوي على مربعات النصوص ' - birthDate (Variant): تاريخ الميلاد (مطلوب) ' - txtYears, txtMonths, txtDays (TextBox, اختياري): كائنات مربعات النصوص للسنوات والأشهر والأيام Public Sub PopulateAgeFields(frm As Form, birthDate As Variant, _ Optional txtYears As TextBox, Optional txtMonths As TextBox, _ Optional txtDays As TextBox) Dim result As String ' متغير لتخزين النتيجة من GetAgeInfo Dim lines() As String ' مصفوفة لتقسيم السلسلة إلى أسطر Dim i As Integer ' متغير للحلقة ' تفريغ جميع مربعات النصوص الممررة أولاً On Error Resume Next ' تجاهل الأخطاء إذا لم يتم تمرير المربع If Not txtYears Is Nothing Then txtYears.Value = "" If Not txtMonths Is Nothing Then txtMonths.Value = "" If Not txtDays Is Nothing Then txtDays.Value = "" On Error GoTo 0 ' التحقق من تاريخ الميلاد ومعالجته فقط إذا كان صالحًا If Not IsNull(birthDate) And IsDate(birthDate) Then ' استدعاء دالة GetAgeInfo لحساب العمر result = GetAgeInfo(birthDate) ' التحقق مما إذا كانت النتيجة تحتوي على خطأ If InStr(result, "يرجى إدخال تاريخ ميلاد صالح") > 0 Or InStr(result, "تاريخ الميلاد يجب أن يكون قبل التاريخ الحالي") > 0 Then ' إذا كان هناك خطأ، تبقى الحقول فارغة (تم تفريغها مسبقًا) Else ' تقسيم السلسلة إلى أسطر لتعيين القيم في مربعات النصوص lines = Split(result, vbCrLf) ' تعيين القيم لمربعات النصوص بناءً على الكائنات الممررة For i = LBound(lines) To UBound(lines) On Error Resume Next ' تجاهل الأخطاء إذا لم يتم تمرير المربع If InStr(lines(i), "السنوات: ") > 0 And Not txtYears Is Nothing Then txtYears.Value = Mid(lines(i), InStr(lines(i), ": ") + 2) ElseIf InStr(lines(i), "الأشهر: ") > 0 And Not txtMonths Is Nothing Then txtMonths.Value = Mid(lines(i), InStr(lines(i), ": ") + 2) ElseIf InStr(lines(i), "الأيام: ") > 0 And Not txtDays Is Nothing Then txtDays.Value = Mid(lines(i), InStr(lines(i), ": ") + 2) End If On Error GoTo 0 Next i End If End If End Sub ' إجراء لعرض تعليمات حول استخدام وحدة حساب العمر ' الغرض: تقديم إرشادات بسيطة للمستخدم حول كيفية استخدام الدوال Public Sub ShowAgeHelp() Dim helpMessage As String helpMessage = "تعليمات استخدام وحدة حساب العمر:" & vbCrLf & vbCrLf & _ "1. GetAgeInfo(birthDate):" & vbCrLf & _ " - birthDate: تاريخ الميلاد (مطلوب، مثال: '2/19/1980')" & vbCrLf & _ " - الإرجاع: سلسلة نصية تحتوي على العمر (سنوات، أشهر، أيام)" & vbCrLf & vbCrLf & _ "2. PopulateAgeFields(frm, birthDate, [txtYears], [txtMonths], [txtDays]):" & vbCrLf & _ " - frm: النموذج الحالي (مطلوب)" & vbCrLf & _ " - birthDate: تاريخ الميلاد (مطلوب)" & vbCrLf & _ " - txtYears, txtMonths, txtDays: كائنات مربعات النصوص للسنوات والأشهر والأيام (اختياري، مثال: Me.txtAgeYears)" & vbCrLf & _ " - مثال: PopulateAgeFields Me, Me.TEmp_BirthDate, Me.txtAgeYears, Me.txtAgeMonths, Me.txtAgeDays" & vbCrLf & vbCrLf & _ "ملاحظات: إذا لم يتم تمرير كائن مربع نص، يتم تجاهله دون إيقاف التنفيذ." MsgBox helpMessage, vbInformation, "تعليمات وحدة حساب العمر" End Sub الاكواد داخل النموذج Option Compare Database Option Explicit Private Sub GetFullInfoByBirthDate() ' تفريغ جميع الحقول غير المرتبطة في كل مرة يتم تحميل سجل جديد On Error Resume Next ' تجاهل الأخطاء إذا كان أي مربع غير موجود Me.txtBirth.Value = "" Me.txtRetAge.Value = "" Me.txtRetirement.Value = "" Me.txtYearsLeft.Value = "" Me.txtMonthsLeft.Value = "" Me.txtDaysLeft.Value = "" Me.txtRetirementDetails.Value = "" Me.txtAgeYears.Value = "" Me.txtAgeMonths.Value = "" Me.txtAgeDays.Value = "" On Error GoTo 0 ' التحقق من وجود تاريخ ميلاد صالح قبل استدعاء الدوال If Not IsNull(Me.TEmp_BirthDate) And IsDate(Me.TEmp_BirthDate) Then ' استدعاء الدالة العامة الخاصة بالتقاعد مع تمرير النموذج وأسماء مربعات النصوص PopulateRetirementFields Me, Me.TEmp_BirthDate, , Me.txtRetAge, Me.txtRetirement, Me.txtYearsLeft, Me.txtMonthsLeft, Me.txtDaysLeft, Me.txtRetirementDetails PopulateAgeFields Me, Me.TEmp_BirthDate, Me.txtAgeYears, Me.txtAgeMonths, Me.txtAgeDays End If End Sub Private Sub Form_Current() GetFullInfoByBirthDate End Sub Private Sub TEmp_BirthDate_AfterUpdate() GetFullInfoByBirthDate End Sub Private Sub btnShowRetirementHelp_Click() ShowRetirementHelp End Sub Private Sub btnShowAgeHelp_Click() ShowAgeHelp End Sub سن التقاعد (5).accdb

طيب انا بالفعل فى محاولتي الاولي استخدمت الاستعلام بالشكل التالي وزي ما حضرتك تفضلت تماما باستخدام أسلوب IIf SELECT tbl_Employees.Emp_Code, tbl_Employees.Emp_Name, tbl_Employees.Emp_BirthDate, IIf(IsNull([Emp_BirthDate]),Null,DateAdd("yyyy",Switch([Emp_BirthDate]<DateSerial(1971,7,1),60,[Emp_BirthDate]<DateSerial(1972,7,1),61,[Emp_BirthDate]<DateSerial(1973,7,1),62,[Emp_BirthDate]<DateSerial(1974,7,1),63,[Emp_BirthDate]<DateSerial(1975,7,1),64,True,65),[Emp_BirthDate])) AS RetirementDate, Switch([Emp_BirthDate]<DateSerial(1971,7,1),60,[Emp_BirthDate]<DateSerial(1972,7,1),61,[Emp_BirthDate]<DateSerial(1973,7,1),62,[Emp_BirthDate]<DateSerial(1974,7,1),63,[Emp_BirthDate]<DateSerial(1975,7,1),64,True,65) AS RetirementAge, IIf(IsNull([RetirementDate]) Or [RetirementDate]<Date(),0,IIf(DateAdd("yyyy",DateDiff("yyyy",Date(),[RetirementDate]),Date())>[RetirementDate],DateDiff("yyyy",Date(),[RetirementDate])-1,DateDiff("yyyy",Date(),[RetirementDate]))) AS RemainingYears, IIf(IsNull([RetirementDate]) Or [RetirementDate]<Date(),0,DateDiff("m",DateAdd("yyyy",[RemainingYears],Date()),[RetirementDate])) AS RemainingMonths, IIf(IsNull([RetirementDate]) Or [RetirementDate]<Date(),0,Abs(DateDiff("d",DateAdd("m",[RemainingMonths],DateAdd("yyyy",[RemainingYears],Date())),[RetirementDate]))) AS RemainingDays, Year([RetirementDate]) AS RetirementYear FROM tbl_Employees WHERE (((Year(IIf(IsNull([Emp_BirthDate]),Null,DateAdd("yyyy",Switch([Emp_BirthDate]<DateSerial(1971,7,1),60,[Emp_BirthDate]<DateSerial(1972,7,1),61,[Emp_BirthDate]<DateSerial(1973,7,1),62,[Emp_BirthDate]<DateSerial(1974,7,1),63,[Emp_BirthDate]<DateSerial(1975,7,1),64,True,65),[Emp_BirthDate]))))>=Year(Date()))) ORDER BY tbl_Employees.Emp_Code, Year(IIf(IsNull([Emp_BirthDate]),Null,DateAdd("yyyy",Switch([Emp_BirthDate]<DateSerial(1971,7,1),60,[Emp_BirthDate]<DateSerial(1972,7,1),61,[Emp_BirthDate]<DateSerial(1973,7,1),62,[Emp_BirthDate]<DateSerial(1974,7,1),63,[Emp_BirthDate]<DateSerial(1975,7,1),64,True,65),[Emp_BirthDate]))); ولكن ولكن ولكن لو قمت بعمل و عرض الاستعلام المباشر السابق مع المثال المرفق وقارنته بالاستعلام الاساسي والذى يعتمد على الكود سوف تجد هناك فروقات وتباين في القيم يا نهار ابيض فروقات ايه الارتباك ده و مين صح و نختار مين وليه حصل فروقات وتباين وعلشان كده انا كتتب الكود ولم اشارك الاستعلام الموجود هنا اساسا فى تقديم الحل تعالي نعرف السبب اولا الكود يوفر لمطور النظم التعديل والتطوير فى أي وقت عن الاستعلام بشكل اكثر سهولة ومرونه ده بغض النظر عن سهولة وإمكانية استخدامه بشكل مرن وسهل فى زوايا التطبيق المختلفة حسب الرغبة ده عير ان الكود ممكن جدا وسهل استخدامه مع قاعدة بيانات مع اختلاف اسماء الجداول والحقول تخيل لو عجبك الاستعلام وتريد نقله الي قاعدتك سوف يكون الموضوع مرهق قليلا طيب ليه فى فروقات وايهم اصح وأدق أو أكثر دقه وليه استبعدت الاستعلام المباشر من الحل وده السبب الرئيسي والذي قد يغفل عنه الكثيــــر أو لا يعرف عنه البعض الكود VBA يحسب الأشهر تدريجيا باستخدام حلقة While مما يضمن عدم التجاوز الاستعلام يستخدم DateDiff("m", ...)، وهو يحسب عدد الأشهر بين تاريخين بغض النظر عن الأيام الدقيقة، مما يعطي تقديرا أعلى و تأثير ذلك بسبب زيادة الأشهر في الاستعلام، التاريخ المؤقت يصبح أبعد عن تاريخ التقاعد مما يؤدي إلى قيم مختلفة في RemainingDays مقارنة النتائج (مثال واحد): الموظف: 1001 (تجربة): تاريخ الميلاد: 2 مايو 1982 تاريخ التقاعد: 2 مايو 2047 التاريخ الحالي: 23 مارس 2025 (بناءً على تاريخ اليوم للمشاركة الحالية ) نتيجة الكود VBA: RemainingYears: 22 RemainingMonths: 1 RemainingDays: 9 نتيجة الاستعلام SQL: RemainingYears: 22 RemainingMonths: 2 RemainingDays: 21 النتيجة: الاستعلام أقل دقة في حساب الأشهر والأيام لأنه يعتمد علي DateDiff مباشرة بدلا من الحساب التدريجي لذلك الاعتماد علي الكود افضل وأكثر دقه من الاستعلام مباشرة وقطعا أكثر مرونه عند التعديل او التطوير او الاستخدام فى أماكن مختلفة شكرا على كلماتكم الطيبة جزاكم الله خيرا تم توضيح سبب أن الداله احترافيه فى السرد بعاليه طيب بالنسبة لهذه الجزئيه نقوم بإعادة تطوير المثال المرفق مرة أخرى تدلل اولا الكود الرئيسي لحساب سن التقاعد وكما أشرنا سابقا سوف يكون داخل وحده نمطيه باسم : basRetirementInfo بالشكل التالي كما هو ولن اعدله حتى يمكن استخدامه داخل اى استعلام Public Function GetRetirementInfo(birthDate As Variant, Optional showDetails As Boolean = False) As String Dim retirementAge As Integer Dim RetirementDate As Date Dim remainingYears As Integer Dim remainingMonths As Integer Dim remainingDays As Integer Dim result As String Dim currentDate As Date Dim tempDate As Date ' التحقق من تاريخ الميلاد If IsNull(birthDate) Or Not IsDate(birthDate) Then result = "يرجى إدخال تاريخ ميلاد صالح" Else birthDate = CDate(birthDate) ' تحديد سن التقاعد بناءً على تاريخ الميلاد If birthDate < DateSerial(1971, 7, 1) Then retirementAge = 60 ElseIf birthDate < DateSerial(1972, 7, 1) Then retirementAge = 61 ElseIf birthDate < DateSerial(1973, 7, 1) Then retirementAge = 62 ElseIf birthDate < DateSerial(1974, 7, 1) Then retirementAge = 63 ElseIf birthDate < DateSerial(1975, 7, 1) Then retirementAge = 64 Else retirementAge = 65 End If ' حساب تاريخ التقاعد RetirementDate = DateAdd("yyyy", retirementAge, birthDate) If showDetails Then currentDate = Date ' حساب السنوات المتبقية remainingYears = DateDiff("yyyy", currentDate, RetirementDate) tempDate = DateAdd("yyyy", remainingYears, currentDate) If tempDate > RetirementDate Then remainingYears = remainingYears - 1 tempDate = DateAdd("yyyy", remainingYears, currentDate) End If ' حساب الأشهر المتبقية remainingMonths = 0 While DateAdd("m", 1, tempDate) <= RetirementDate remainingMonths = remainingMonths + 1 tempDate = DateAdd("m", 1, tempDate) Wend ' حساب الأيام المتبقية remainingDays = DateDiff("d", tempDate, RetirementDate) ' تجميع النتيجة result = "تاريخ الميلاد: " & birthDate & vbCrLf & _ "سن التقاعد: " & retirementAge & vbCrLf & _ "تاريخ التقاعد: " & RetirementDate & vbCrLf & _ "السنوات المتبقية: " & remainingYears & vbCrLf & _ "الأشهر المتبقية: " & remainingMonths & vbCrLf & _ "الأيام المتبقية: " & remainingDays Else result = "تاريخ التقاعد: " & RetirementDate End If End If GetRetirementInfo = result End Function الان سوف أقوم بعم داله مساعده للفصل والتوزيع : فى نفس الوحده النمطيه العامة Public Sub PopulateRetirementFields(frm As Form, birthDate As Variant, _ Optional txtBirthDateName As String = "", Optional txtRetirementAgeName As String = "", _ Optional txtRetirementDateName As String = "", Optional txtRemainingYearsName As String = "", _ Optional txtRemainingMonthsName As String = "", Optional txtRemainingDaysName As String = "") Dim result As String Dim lines() As String Dim i As Integer ' استدعاء الكود الأصلي مع التفاصيل result = GetRetirementInfo(birthDate, True) ' التحقق مما إذا كانت النتيجة تحتوي على خطأ If result = "يرجى إدخال تاريخ ميلاد صالح" Then If txtBirthDateName <> "" Then frm.Controls(txtBirthDateName) = result If txtRetirementAgeName <> "" Then frm.Controls(txtRetirementAgeName) = "" If txtRetirementDateName <> "" Then frm.Controls(txtRetirementDateName) = "" If txtRemainingYearsName <> "" Then frm.Controls(txtRemainingYearsName) = "" If txtRemainingMonthsName <> "" Then frm.Controls(txtRemainingMonthsName) = "" If txtRemainingDaysName <> "" Then frm.Controls(txtRemainingDaysName) = "" Else ' تقسيم السلسلة إلى أسطر lines = Split(result, vbCrLf) ' تعيين القيم لمربعات النصوص بناءً على الأسماء الممررة For i = LBound(lines) To UBound(lines) On Error Resume Next ' تجاهل الأخطاء إذا كان المربع غير موجود If InStr(lines(i), "تاريخ الميلاد: ") > 0 And txtBirthDateName <> "" Then frm.Controls(txtBirthDateName) = Mid(lines(i), InStr(lines(i), ": ") + 2) ElseIf InStr(lines(i), "سن التقاعد: ") > 0 And txtRetirementAgeName <> "" Then frm.Controls(txtRetirementAgeName) = Mid(lines(i), InStr(lines(i), ": ") + 2) ElseIf InStr(lines(i), "تاريخ التقاعد: ") > 0 And txtRetirementDateName <> "" Then frm.Controls(txtRetirementDateName) = Mid(lines(i), InStr(lines(i), ": ") + 2) ElseIf InStr(lines(i), "السنوات المتبقية: ") > 0 And txtRemainingYearsName <> "" Then frm.Controls(txtRemainingYearsName) = Mid(lines(i), InStr(lines(i), ": ") + 2) ElseIf InStr(lines(i), "الأشهر المتبقية: ") > 0 And txtRemainingMonthsName <> "" Then frm.Controls(txtRemainingMonthsName) = Mid(lines(i), InStr(lines(i), ": ") + 2) ElseIf InStr(lines(i), "الأيام المتبقية: ") > 0 And txtRemainingDaysName <> "" Then frm.Controls(txtRemainingDaysName) = Mid(lines(i), InStr(lines(i), ": ") + 2) End If On Error GoTo 0 ' إعادة تعيين معالجة الأخطاء Next i End If End Sub ويتم استدعاء هذه الداله فقط بتمرير اسماء مربعات النص كما هي فى النموذج والتي سوف تسميها انت علي حسب اختياراتك وتمررها للكود حسب الاسماء التي سوف تستخدمها مثال الاستدعاء فى النموذج PopulateRetirementFields Me, Me.TEmp_BirthDate, "Birth", "RetAge", "Retirement", "YearsLeft", "MonthsLeft", "DaysLeft" طيب انا كتبت الداله بمرونه بحيث اعرض ما اريد عرضه فقط حسب تمرير المعاملات لنفترض انه لا اريد عمل مربع نص لتاريخ الميلاد مرة أخري علي اعتبار انه موجود اصلا في النموذج وبناء عليه تتم العمليه كلها اساسا في هذه الحالة نستدعي الداله بالشكل التالي تماما PopulateRetirementFields Me, Me.TEmp_BirthDate, "", "RetAge", "Retirement", "YearsLeft", "MonthsLeft", "DaysLeft" طيب وبنفس المنطق يمكن عمل داله حساب العمر بالشكل التالي فى وحده نمطيه عامة باسم : basAgeInfo الكود : Public Function GetAgeInfo(birthDate As Variant) As String Dim ageYears As Integer Dim ageMonths As Integer Dim ageDays As Integer Dim currentDate As Date Dim tempDate As Date Dim result As String ' التحقق من تاريخ الميلاد If IsNull(birthDate) Or Not IsDate(birthDate) Then result = "يرجى إدخال تاريخ ميلاد صالح" Else birthDate = CDate(birthDate) currentDate = Date ' التأكد من أن تاريخ الميلاد قبل التاريخ الحالي If birthDate > currentDate Then result = "تاريخ الميلاد يجب أن يكون قبل التاريخ الحالي" Else ' حساب السنوات ageYears = DateDiff("yyyy", birthDate, currentDate) tempDate = DateAdd("yyyy", ageYears, birthDate) If tempDate > currentDate Then ageYears = ageYears - 1 tempDate = DateAdd("yyyy", ageYears, birthDate) End If ' حساب الأشهر ageMonths = 0 While DateAdd("m", 1, tempDate) <= currentDate ageMonths = ageMonths + 1 tempDate = DateAdd("m", 1, tempDate) Wend ' حساب الأيام ageDays = DateDiff("d", tempDate, currentDate) ' تجميع النتيجة result = "تاريخ الميلاد: " & birthDate & vbCrLf & _ "السنوات: " & ageYears & vbCrLf & _ "الأشهر: " & ageMonths & vbCrLf & _ "الأيام: " & ageDays End If End If GetAgeInfo = result End Function للفصل والتوزيع : فى نفس الوحده النمطيه العامة الكود Public Sub PopulateAgeFields(frm As Form, birthDate As Variant, _ Optional txtYearsName As String = "", Optional txtMonthsName As String = "", _ Optional txtDaysName As String = "") Dim result As String Dim lines() As String Dim i As Integer ' استدعاء دالة حساب العمر result = GetAgeInfo(birthDate) ' التحقق مما إذا كانت النتيجة تحتوي على خطأ If InStr(result, "يرجى إدخال تاريخ ميلاد صالح") > 0 Or InStr(result, "تاريخ الميلاد يجب أن يكون قبل التاريخ الحالي") > 0 Then If txtYearsName <> "" Then frm.Controls(txtYearsName) = "" If txtMonthsName <> "" Then frm.Controls(txtMonthsName) = "" If txtDaysName <> "" Then frm.Controls(txtDaysName) = "" Else ' تقسيم السلسلة إلى أسطر lines = Split(result, vbCrLf) ' تعيين القيم لمربعات النصوص بناءً على الأسماء الممررة For i = LBound(lines) To UBound(lines) On Error Resume Next ' تجاهل الأخطاء إذا كان المربع غير موجود If InStr(lines(i), "السنوات: ") > 0 And txtYearsName <> "" Then frm.Controls(txtYearsName) = Mid(lines(i), InStr(lines(i), ": ") + 2) ElseIf InStr(lines(i), "الأشهر: ") > 0 And txtMonthsName <> "" Then frm.Controls(txtMonthsName) = Mid(lines(i), InStr(lines(i), ": ") + 2) ElseIf InStr(lines(i), "الأيام: ") > 0 And txtDaysName <> "" Then frm.Controls(txtDaysName) = Mid(lines(i), InStr(lines(i), ": ") + 2) End If On Error GoTo 0 ' إعادة تعيين معالجة الأخطاء Next i End If End Sub ويتم الاستدعاء بنفس المنطق السابق لدله التقاعد بالشكل التالى : PopulateAgeFields Me, Me.TEmp_BirthDate, "txtAgeYears", "txtAgeMonths", "txtAgeDays" طيب لو افترضنا انه نريد العمر بعددد السنوات فقط يكون الاستدعاء PopulateAgeFields Me, Me.TEmp_BirthDate, "txtAgeYears", "", "" أو PopulateAgeFields Me, Me.TEmp_BirthDate, "txtAgeYears" ملاحظة : المرفق يحتوى على الاستعلام : qryRetirementInfo يعتمد على الداله الرئيسيه لحساب سن التقاعد فى الكود الاستعلام : Query1 يحسب سن التقاعد بشكل مباشر بدون التقيد بضوابط الحساب تبعا للقانون يعتمد على العام فقط بدون الشهر وطبعا ده غير صحيح الاستعلام : Query2 يحسب سن التقاعد بشكل مباشر مع التقيد بضوابط الحساب تبعا للقانون و يعتمد على الشهر و العام - وطبعا ده غير دقيق وأخيـــــــــــــــرا المرفق سن التقاعد (4).accdb

انا وضعت الاجابة بشكل مفصل لتكون مرجعا شاملا وشرحا وافيا وردا على سؤال حضرتك بإختصار شديد جدا جدا إذا كانت البيانات غير متسقة أو تحتوي على إدخالات غير متوقعة مثل المسافات الزائده بدون داعى اما عن طريق الخطأ او بسبب تنفيذ اى عملية خطأ فدائما أحاول بقدر الإمكان عند تقديم أى حلول التكد من سد أى ثغرات تؤدى الى أخطاء مستقبليه ولن يتم اكتشافها فى الوقت الراهن استاذى الجليل ومعلمى القدير طبعا كل كلماتى شكرى وتقدير لكم سوف تقف عاجزة وقاصرة أمامكم وأمام كل المجهود وكل العلم الذى تقدمونه وأمام ما تعلمناه وسوف نتعمله نحن كل طلاب العلم فى هذا الصرح الشامخ على اياديكم المباركة أنتم وباقى كل اساتذتى العظماء شكر الله لكم وأحسن اليكم كما تحسنون الينا وكل طلاب العلم وجزاكم الله خيـرا وكتبه لكم فى موازين اعمالكم ان شاء الله كلماتكم الطيبه وسام عزة جزاكم الله خيـرا ولكن هذا فضل الله تعالى اولا ثم فضلكم انتم فهذا حصاد و ثمار ما زرعتم وتزرعون وانا من يسعدنى ويشرفنى ان اشارك مع اساتذتى العظماء احبكم فى الله

طبعا مما لاشك فيه لابد للطالب من الاستئذان توقيرا واجلا للمعلم القدير الجليل حاسس انى اتدبست - او غلطت فى شئ - أو يتم اختبارى وأنا أقلق من هذه الموافق جدا ولكن سوف ادلى بدلوي فإن اخطأت فهذا مني ومن سوء فهمي وتقديري أنا و وقتها تصحون لي خطئي وجزاكم الله عني كل خير وإن أصبت فلقد تعلمت على ايديكم فأنتم أحد الأساتذة العظماء الذين أدين لهم بالفضل بعد رب العزة سبحانه وتعالي سؤالك جدا ممتاز يا أستاذي ويفتح مجالا لفهم أعمق لدالتي Nz وTrim خاصة في سياق التحقق من الحقول الفارغة دعني أوضح حسب فهمى المتواضح الفائدة من استخدام هاتين الدالتين ومتى تكونان ضرورييتان و ما الفرق بين استخدامهما أو عدمهما مع مثال أولا شرح الدالتين: 1- دالة Nz : Nz(Value, ValueIfNull) تستخدم لتحويل قيمة Null إلى قيمة أخرى محددة (مثل "" أو 0 حسب رغبة مطور النظم ) مفيدة جدا عندما تتعامل مع حقل قد يحتوي على Null لأن أي عملية مقارنة مع Null (مثل Null = "") ترجع Null وليس True أو False 2- دالة Trim : Trim(Value) تزيل المسافات البيضاء (Whitespace) من بداية و نهاية السلسلة النصية مثل " abs " أو " abs" أو "abs " تصبح "abc" لا تتعامل مع Null فإذا كانت القيمة هى Null فإن Trim(Null) يظل Null الهدف: تريد التحقق مما إذا كان الحقل (Me.yyy) "فارغا" أم لا "فارغ" قد يعني: Null (لا قيمة على الإطلاق) "" (سلسلة فارغة). " " أو " " (مسافات فقط) ** إذا كان الحقل فارغا بأي من هذه الحالات يتحقق الشرط و إذا كان يحتوي على قيمة فعلية (مثل "abc") لا يتحقق الشرط. سؤال حضرتك : هل استخدام Nz و Trim يضيف ميزة إضافية في هذا السياق أم أن التحقق الأساسي بـ IsNull و = "" كاف؟ 1- بدون Nz و Trim: If Me.xxx <> 0 And (IsNull(Me.yyy) Or Me.yyy = "") Then ' الشرط تحقق Else End If يتحقق الشرط إذا: Me.yyy هو Null Me.yyy هو "" (سلسلة فارغة) لا يتحقق الشرط إذا: Me.yyy يحتوي على مسافات فقط (مثل " " أو " ")، لأن " " <> "" Me.yyy يحتوي على نص (مثل "abc")، وهذا متوقع 2- مع Nz و Trim: If Me.xxx <> 0 And (IsNull(Me.yyy) Or Trim(Nz(Me.yyy, "")) = "") Then ' الشرط تحقق Else End If يتحقق الشرط إذا: Me.yyy هو Null (لأن Nz يحوله إلى "" و Trim("") = "") Me.yyy هو "" (لأن Trim("") = "") Me.yyy هو " " أو " " (لأن Trim(" ") = "") لا يتحقق الشرط إذا: Me.yyy يحتوي على نص فعلي (مثل "abc")، لأن Trim("abc") <> "" الميزة الإضافية لـ Nz و Trim: Nz: يضمن التعامل مع Null بطريقة آمنة مما يمنع أي أخطاء غير متوقعة إذا حاولت مقارنة Null مباشرة في الكود بدون Nz الشرط IsNull(Me.yyy) كاف لكن استخدام Nz يجعل الكود أكثر مرونة إذا أردت لاحقا إجراء عمليات إضافية على القيمة Trim: يضيف القدرة على اعتبار المسافات البيضاء (Whitespace) كقيمة "فارغة" بدون Trim إذا كان Me.yyy = " " »--»» فإن الشرط لن يتحقق لأن " " <> "" الفرق الأساسي: بدون Trim و Nz: لا يعتبر المسافات فقط (" ") فارغة مع Trim و Nz: يعتبر المسافات فقط فارغة بالإضافة إلى Null و "" الأمثلة العملبة : 1- الكود بدون Nz و Trim Me.xxx = 5 , Me.yyy = Null → "الشرط تحقق" Me.xxx = 5 , Me.yyy = "" → "الشرط تحقق" Me.xxx = 5 , Me.yyy = " " → "الشرط لم يتحقق" (لأن " " <> "") "Me.xxx = 5 , Me.yyy = "abc → "الشرط لم يتحقق" 2- الكود مع Nz و Trim Me.xxx = 5 , Me.yyy = Null → "الشرط تحقق" Me.xxx = 5 , Me.yyy = "" → "الشرط تحقق" Me.xxx = 5 , Me.yyy = " " → "الشرط تحقق" (لأن Trim(" ") = "") "Me.xxx = 5 , Me.yyy = "abc → "الشرط لم يتحقق" الخلاصة: إذا كان مطور النظم لا يهتم بالمسافات (مثل " " ) ويتعتبرها قيمة غير فارغة فالكود الأبسط بدون Nz و Trim كاف إذا كان مطور النظم يريد أن تعتبر المسافات فارغة (مثل " " ) فاستخدام Trim و Nz يعطي ميزة إضافية إذا نستخلص مما سبق أن Trim و Nz يجعلان الكود أكثر شمولية للتعامل مع جميع حالات "الفراغ" ( Null , سلسلة فارغة , مسافات فقط ) مما يجعله أكثر مرونة إذا كانت البيانات غير متسقة أو تحتوي على إدخالات غير متوقعة مثل المسافات

و مشاركه مع استاذى القدير و معلمى الجليل الاستاذ @ابو عارف وطبعا بعد إذنه اضافة بسيطه If Me.xxx <> 0 And (IsNull(Me.yyy) Or Trim(Nz(Me.yyy, "")) = "") Then ' هنا نكتب الحدث Else End If Nz(Me.yyy, ""): يحول Null إلى "" Trim(...) = "": يتحقق إذا كانت النتيجة بعد إزالة المسافات فارغة مما يغطي Null , "" , " "

طيب الحل فى المشاركة السابقة كنت قمت به اجتهادا قبل فترة من الزمن ولكن لم اكن على دراية كاملة بالتفاصيل آنذاك وذلك كان فى بداية الشروع لسن هذا القانون و بكل صراحة انا وضعت الحل اولا قبل محاولة فتح الاكسل اصلا بناء على دراية سابقة ولكن استوقفتنى هذه الجملة عند مراجعتى للموضوع بعد نشر الحل الاول بالمشاركة السابقة و بعد فتح الاكسل وبعد وضع الحل فى المشاركة وبالاخص بعد كســر الحماية عن ملف الاكسل وبعد التركيز اكتشفت انه هناك شرط أخر ايضا ليس فقط عام الميلاد المستخرج من تاريخ الميلاد ولكن العام مع الشهر وبعد البحث على الانترنت وعن القانون الذى لم أكن اعرف رقمه حصلت على التالى * ملاحظة هامة : الجدول السابق لا يوضح صراحة سن التقاعد للمواليد قبل 1 يوليو 1971 لذلك سوف أفترض أنهم يخرجون على المعاش في سن 60 عاما وهو السن التقليدي قبل تطبيق الزيادة التدريجية لذلك سوف أقوم ببعض التعديلات للتناسب مع كل الشروط السابقة الكود الجديد Public Function GetRetirementInfo(birthDate As Variant, Optional showDetails As Boolean = False) As String Dim retirementAge As Integer Dim retirementDate As Date Dim remainingYears As Integer Dim remainingMonths As Integer Dim remainingDays As Integer Dim result As String Dim currentDate As Date Dim tempDate As Date ' التحقق من تاريخ الميلاد If IsNull(birthDate) Or Not IsDate(birthDate) Then result = "يرجى إدخال تاريخ ميلاد صالح" Else birthDate = CDate(birthDate) ' تحديد سن التقاعد بناءً على تاريخ الميلاد If birthDate < DateSerial(1971, 7, 1) Then retirementAge = 60 ElseIf birthDate < DateSerial(1972, 7, 1) Then retirementAge = 61 ElseIf birthDate < DateSerial(1973, 7, 1) Then retirementAge = 62 ElseIf birthDate < DateSerial(1974, 7, 1) Then retirementAge = 63 ElseIf birthDate < DateSerial(1975, 7, 1) Then retirementAge = 64 Else retirementAge = 65 End If ' حساب تاريخ التقاعد retirementDate = DateAdd("yyyy", retirementAge, birthDate) If showDetails Then currentDate = Date ' حساب السنوات المتبقية remainingYears = DateDiff("yyyy", currentDate, retirementDate) tempDate = DateAdd("yyyy", remainingYears, currentDate) If tempDate > retirementDate Then remainingYears = remainingYears - 1 tempDate = DateAdd("yyyy", remainingYears, currentDate) End If ' حساب الأشهر المتبقية remainingMonths = 0 While DateAdd("m", 1, tempDate) <= retirementDate remainingMonths = remainingMonths + 1 tempDate = DateAdd("m", 1, tempDate) Wend ' حساب الأيام المتبقية remainingDays = DateDiff("d", tempDate, retirementDate) ' تجميع النتيجة result = "تاريخ الميلاد: " & birthDate & vbCrLf & _ "سن التقاعد: " & retirementAge & vbCrLf & _ "تاريخ التقاعد: " & retirementDate & vbCrLf & _ "السنوات المتبقية: " & remainingYears & vbCrLf & _ "الأشهر المتبقية: " & remainingMonths & vbCrLf & _ "الأيام المتبقية: " & remainingDays Else result = "تاريخ التقاعد: " & retirementDate End If End If GetRetirementInfo = result End Function و يتم استدعاء الكود بأحد الطريقتين تمام كما تم مع الكود السابق الاولى للحصول على تاريخ التقاعد فقط GetRetirementInfo([Emp_BirthDate]) الثانية : بيانات شاملة GetRetirementInfo([Emp_BirthDate],True) وبهذا تكون هذه القاعده الجديده بهذا الكود وفق المعايير الصحيحه طبقا للقانون وأخيرا المرفق سن التقاعد (3).accdb

اتفضل ده الكود فى الوحده النمطيه التى تحمل اسم : basRetirementInfo Option Compare Database Option Explicit Public Function GetRetirementInfo(birthDate As Variant, Optional showDetails As Boolean = False) As String Dim retirementAge As Integer Dim retirementDate As Date Dim remainingYears As Integer Dim remainingMonths As Integer Dim remainingDays As Integer Dim retirementYear As Integer Dim result As String ' التحقق من أن تاريخ الميلاد ليس فارغًا If IsNull(birthDate) Or Not IsDate(birthDate) Then result = "يرجى إدخال تاريخ ميلاد صالح" Else birthDate = CDate(birthDate) ' تحديد سن التقاعد بناءً على سنة الميلاد Select Case Year(birthDate) Case Is < 1972 retirementAge = 60 Case Is < 1974 retirementAge = 61 Case Is < 1976 retirementAge = 62 Case Is < 1978 retirementAge = 63 Case Is < 1980 retirementAge = 64 Case Else retirementAge = 65 End Select ' حساب تاريخ التقاعد retirementDate = DateAdd("yyyy", retirementAge, birthDate) retirementYear = Year(retirementDate) If showDetails Then ' حساب السنوات والأشهر والأيام المتبقية حتى التقاعد remainingYears = IIf(DateDiff("yyyy", Date, retirementDate) < 0, 0, DateDiff("yyyy", Date, retirementDate)) remainingMonths = IIf(DateDiff("m", Date, retirementDate) < 0, 0, DateDiff("m", Date, retirementDate)) remainingDays = IIf(DateDiff("d", Date, retirementDate) < 0, 0, DateDiff("d", Date, retirementDate)) ' إعداد النتيجة مع كل التفاصيل result = "تاريخ الميلاد: " & birthDate & vbCrLf & _ "سن التقاعد: " & retirementAge & vbCrLf & _ "تاريخ التقاعد: " & retirementDate & vbCrLf & _ "سنة التقاعد: " & retirementYear & vbCrLf & _ "السنوات المتبقية: " & remainingYears & vbCrLf & _ "الأشهر المتبقية: " & remainingMonths & vbCrLf & _ "الأيام المتبقية: " & remainingDays Else ' إعداد النتيجة لتاريخ التقاعد فقط result = retirementDate End If End If ' إرجاع النتيجة GetRetirementInfo = result End Function بيتم استدعاء الكود بأحد الطريقتين الاولى للحصول على تاريخ التقاعد فقط GetRetirementInfo([Emp_BirthDate]) الثانية : بيانات شاملة GetRetirementInfo([Emp_BirthDate],True) طبعا مفيش دلع اكتر من كده ... شغل فاخر من الاخر وطبعا انت جايب لنا ملف اكسل مقفول وده يا سيدى ملف الاكسل مفتوح حذفت لك الحمايه من عليه علشان تقدر تشوف المعادلات بس ركز علشان المعادلات ما تخرب منك بدون ما تشعر داخل الاكسل برنامج حساب سن المعاش 2.xlsx سن التقاعد 2.accdb

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

اثراء للموضوع دى داله معدله ومحدثه لـما يعرف بـ ShellWait أو Shell_n_Wait فى هذا الموضوع