سن التقاعد ( القانون المصري ) حساب تاريخ سن المعاش تبعا لقانون التأمينات والمعاشات المصري الجديد 148 لعام 2019

Lotfy14 · الأحد at 09:13

السادة الافاضل

خبراء المنتدى الكرام

مرفق ملف اكسيل لقانون التأمينات والمعاشات لعام 2019

وبه طريقة احتساب بلوغ سن المعاش طبقا للمكرر من التأمينات

مع مراعاه ان لكل فترة معينه يتم احتساب بلوغ سن المعاش على سنين معينة وليست على الــ 60 عام

كما يوجد بالملف الاكسيل ان يتم ابلغى خروج الموظف على كام عام

مرفق ملف ( اكسس ) للتطبيق علية

برجاء افادتنا بالتطبيق ملف الاكسس

برنامج حساب سن المعاش.xlsx

سن التقاعد 2.accdb

تم تعديل الإثنين at 00:37 بواسطه ابو جودي
تعديل العنوان و اضافة وسوم لعنوان الموضوع

**Foksh** · الأحد at 13:53

4 ساعات مضت, Lotfy14 said:

مع مراعاه ان لكل فترة معينه يتم احتساب بلوغ سن المعاش على سنين معينة وليست على الــ 60 عام

وعليكم السلام ورحمة الله وبركاته ..

كمعلومة من أحد الإصدقاء لي في مصر الشقيقة ,,

هل قانون التأمينات الجديد لعام 2019 بيحدد سن المعاش تدريجياً حسب سنة الميلاد بالشكل التالي :-

مواليد قبل 1/1/1959 : سن التقاعد 60 سنة ، مواليد من 1959 إلى 1961 : سن التقاعد 61 سنة ، مواليد من 1962 إلى 1964 : سن التقاعد 62 سنة ، مواليد من 1965 إلى 1967 : سن التقاعد 63 سنة ، مواليد من 1968 إلى 1970 : سن التقاعد 64 سنة ، مواليد 1971 وما بعدها : سن التقاعد 65 سنة ؟؟؟؟؟؟؟

**ابو جودي** · الأحد at 14:38

اتفضل

ده الكود فى الوحده النمطيه التى تحمل اسم : 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

**ابو جودي** · الأحد at 18:37

طيب الحل فى المشاركة السابقة كنت قمت به اجتهادا قبل فترة من الزمن ولكن لم اكن على دراية كاملة بالتفاصيل آنذاك وذلك كان فى بداية الشروع لسن هذا القانون

و بكل صراحة انا وضعت الحل اولا قبل محاولة فتح الاكسل اصلا بناء على دراية سابقة

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

9 ساعات مضت, Lotfy14 said:

لقانون التأمينات والمعاشات لعام 2019

و بعد فتح الاكسل وبعد وضع الحل فى المشاركة وبالاخص بعد كســر الحماية عن ملف الاكسل وبعد التركيز اكتشفت انه هناك شرط أخر ايضا

ليس فقط عام الميلاد المستخرج من تاريخ الميلاد ولكن العام مع الشهر

وبعد البحث على الانترنت وعن القانون الذى لم أكن اعرف رقمه حصلت على التالى

اقتباس

وفيما يلي ننشر الزيادة التدريجية في سن المعاش والتي جاءت كالتالي:

- مواليد 1 يوليو 1971 - عام المعاش في يوليو 2032 - 61 عامًا.
مواليد 1 يوليو 1972 - عام المعاش في يوليو 2034 - 62 عامًا.
- مواليد 1 يوليو عام 1973 - عام المعاش في يوليو 2036 ـ 63 عاما.
- مواليد 1 يوليو عام 1974 عام المعاش في يوليو 2038 - 64 عامًا.
- مواليد 1 يوليو عام 1975- وما بعدها- عام المعاش يوليو 2040 - بسن 65 عاما.

* ملاحظة هامة :
الجدول السابق لا يوضح صراحة سن التقاعد للمواليد قبل 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

أحمد العيسى · الأحد at 19:44

القاعدة المشار إليها تم استخدامى لها من قبل فى قاعدة بيانات المدرسين

ولكن باستخدام أسلوب IIf

لكن من الجميل جداً أن يكون العمل من خلال دالة احترافية كما تفضلت هنا

بالنسبة للبيانات الشاملة يفضل أن يكون الباقى على تاريخ المعاش مفصلاً

بالسنة والشهر واليوم كما فى الصور التالية

**Foksh** · الأحد at 23:45

ما دام الأمر متوسعاً إلى هذا الحد 😁 ، فهذه فكرتي المتواضعة البسيطة ، وتضم 3 طرق بشكل (مباشر وغير مباشر ) لتحقيق الهدف

مديول عام يضم الأساليب الثلاثة كالتالي :-

' الدالة الأولى: حساب تاريخ التقاعد فقط
Public Function CalculateRetirementDate(birthDateControl As Object) As Variant
    Dim birthDate As Date
    Dim retirementAge As Integer
    Dim retirementDate As Date
    Dim inputDate As String
    
    If IsNull(birthDateControl.Value) Or birthDateControl.Value = "" Then
        MsgBox "يرجى إدخال تاريخ ميلاد", vbExclamation + vbMsgBoxRight
        CalculateRetirementDate = Null
        Exit Function
    End If
    
    If Not IsDate(birthDateControl.Value) Then
        MsgBox "تاريخ الميلاد غير صحيح . يرجى إدخال تاريخ بتنسيق صحيح (يوم/شهر/سنة)", vbExclamation + vbMsgBoxRight
        CalculateRetirementDate = Null
        Exit Function
    End If
    
    birthDate = CDate(birthDateControl.Value)
    
    If birthDate > Date Then
        MsgBox "تاريخ الميلاد لا يمكن أن يكون في المستقبل", vbExclamation + vbMsgBoxRight
        CalculateRetirementDate = Null
        Exit Function
    End If
    
    If Year(birthDate) < 1900 Then
        MsgBox "تاريخ الميلاد غير منطقي. يرجى إدخال تاريخ صحيح", vbExclamation + vbMsgBoxRight
        CalculateRetirementDate = Null
        Exit Function
    End If
    
    Select Case Year(birthDate)
        Case Is < 1960
            retirementAge = 60
        Case 1960 To 1964
            retirementAge = 61
        Case 1965 To 1969
            retirementAge = 62
        Case 1970 To 1974
            retirementAge = 63
        Case 1975 To 1979
            retirementAge = 64
        Case Is >= 1980
            retirementAge = 65
        Case Else
            MsgBox "تاريخ الميلاد خارج نطاق الحساب", vbExclamation + vbMsgBoxRight
            CalculateRetirementDate = Null
            Exit Function
    End Select
    
    retirementDate = DateAdd("yyyy", retirementAge, birthDate) - 1
    
    CalculateRetirementDate = retirementDate
End Function

' الدالة الثانية: حساب تاريخ التقاعد فقط (غير منضم)
Public Function GetRetirementDateByBirth(birthDateInput As Object) As Variant
    Dim inputBirthDate As Date
    Dim ageAtRetirement As Integer
    Dim calculatedRetirementDate As Date
    
    If IsNull(birthDateInput.Value) Or birthDateInput.Value = "" Then
        GetRetirementDateByBirth = "لم يتم إدخال تاريخ ميلاد لهذا الموظف"
        Exit Function
    End If
    
    If IsDate(birthDateInput.Value) Then
        inputBirthDate = CDate(birthDateInput.Value)
        
        Select Case Year(inputBirthDate)
            Case Is < 1960
                ageAtRetirement = 60
            Case 1960 To 1964
                ageAtRetirement = 61
            Case 1965 To 1969
                ageAtRetirement = 62
            Case 1970 To 1974
                ageAtRetirement = 63
            Case 1975 To 1979
                ageAtRetirement = 64
            Case Is >= 1980
                ageAtRetirement = 65
            Case Else
                MsgBox "تاريخ الميلاد خارج نطاق الحساب", vbExclamation + vbMsgBoxRight
                GetRetirementDateByBirth = Null
                Exit Function
        End Select
        
        calculatedRetirementDate = DateAdd("yyyy", ageAtRetirement, inputBirthDate) - 1
        
        GetRetirementDateByBirth = calculatedRetirementDate
    Else
        MsgBox "يرجى إدخال تاريخ ميلاد صحيح", vbExclamation + vbMsgBoxRight
        GetRetirementDateByBirth = Null
    End If
End Function

' الدالة الثالثة: حساب تاريخ التقاعد مع المدة المتبقية
Public Function CalculateRetirementInfo(birthDateField As Object) As String
    Dim employeeBirthDate As Date
    Dim retirementAge As Integer
    Dim retirementDate As Date
    Dim timeRemaining As String
    Dim currentDate As Date
    
    currentDate = Date
    
    If IsNull(birthDateField.Value) Or birthDateField.Value = "" Then
        CalculateRetirementInfo = "لم يتم إدخال تاريخ ميلاد لهذا الموظف"
        Exit Function
    End If
    
    If IsDate(birthDateField.Value) Then
        employeeBirthDate = CDate(birthDateField.Value)
        
        Select Case Year(employeeBirthDate)
            Case Is < 1960
                retirementAge = 60
            Case 1960 To 1964
                retirementAge = 61
            Case 1965 To 1969
                retirementAge = 62
            Case 1970 To 1974
                retirementAge = 63
            Case 1975 To 1979
                retirementAge = 64
            Case Is >= 1980
                retirementAge = 65
            Case Else
                CalculateRetirementInfo = "تاريخ الميلاد خارج نطاق الحساب"
                Exit Function
        End Select
        
        retirementDate = DateAdd("yyyy", retirementAge, employeeBirthDate) - 1
        
        timeRemaining = GetTimeRemaining(currentDate, retirementDate)
        
        CalculateRetirementInfo = "تاريخ سن التقاعد في : " & Format(retirementDate, "dd/mm/yyyy") & " ، وبقي عليه " & timeRemaining
    Else
        CalculateRetirementInfo = "تاريخ الميلاد غير صحيح"
    End If
End Function

' دالة مساعدة: حساب الفرق بين تاريخين
Public Function GetTimeRemaining(startDate As Date, endDate As Date) As String
    Dim yearsDiff As Integer
    Dim monthsDiff As Integer
    Dim daysDiff As Integer
    Dim yearsText As String
    Dim monthsText As String
    Dim daysText As String
    
    yearsDiff = DateDiff("yyyy", startDate, endDate)
    If DateAdd("yyyy", yearsDiff, startDate) > endDate Then
        yearsDiff = yearsDiff - 1
    End If
    
    monthsDiff = DateDiff("m", DateAdd("yyyy", yearsDiff, startDate), endDate)
    If DateAdd("m", monthsDiff, DateAdd("yyyy", yearsDiff, startDate)) > endDate Then
        monthsDiff = monthsDiff - 1
    End If
    
    daysDiff = DateDiff("d", DateAdd("m", monthsDiff, DateAdd("yyyy", yearsDiff, startDate)), endDate)
    
    Select Case yearsDiff
        Case 1, 2
            yearsText = "سنة"
        Case 3 To 10
            yearsText = "سنوات"
        Case Else
            yearsText = "سنة"
    End Select
    
    Select Case monthsDiff
        Case 1, 2
            monthsText = "شهر"
        Case 3 To 10
            monthsText = "أشهر"
        Case Else
            monthsText = "شهر"
    End Select
    
    Select Case daysDiff
        Case 1, 2
            daysText = "يوم"
        Case 3 To 10
            daysText = "أيام"
        Case Else
            daysText = "يوم"
    End Select
    
    GetTimeRemaining = yearsDiff & " " & yearsText & " و " & monthsDiff & " " & monthsText & " و " & daysDiff & " " & daysText
End Function

والفكرة الأولى لحدث بعد التحديث لمربع نص تاريخ الميلاد =

 الفكرة الأولى تتحقق بشكل مباشر من خلال حدث بعد التحديث دون دالة في وحدة نمطية
Private Sub TEmp_BirthDate_AfterUpdate()
    Dim birthDate As Date
    Dim retirementAge As Integer
    Dim retirementDate As Date

    If IsDate(Me.TEmp_BirthDate) Then
        birthDate = Me.TEmp_BirthDate

        Select Case Year(birthDate)
            Case Is < 1959
                retirementAge = 60
            Case 1959 To 1961
                retirementAge = 61
            Case 1962 To 1964
                retirementAge = 62
            Case 1965 To 1967
                retirementAge = 63
            Case 1968 To 1970
                retirementAge = 64
            Case Is >= 1971
                retirementAge = 65
            Case Else
                MsgBox "تاريخ الميلاد خارج نطاق الحساب", vbExclamation + vbMsgBoxRight
                Exit Sub
        End Select

        retirementDate = DateAdd("yyyy", retirementAge, birthDate) - 1

        Me.M2 = retirementDate
    Else
        MsgBox "يرجى إدخال تاريخ ميلاد صحيح", vbExclamation
    End If
End Sub

والفكرة الثانية لحدث بعد التحديث لمربع نص تاريخ الميلاد =

'الفكرة الثانية تتحقق بشكل مباشر من خلال حدث بعد التحديث باستخدام دالة في وحدة نمطية
Private Sub TEmp_BirthDate_AfterUpdate()
    Dim retirementDate As Variant
    retirementDate = CalculateRetirementDate(Me.TEmp_BirthDate)
    
    If Not IsNull(retirementDate) Then
        Me.M2 = retirementDate
    End If
End Sub

الفكرة الثالثة والرابعة من خلال مصدر بيانات مربع النص لمربع سن التقاعد أو المعاش =

=GetRetirementDateByBirth([TEmp_BirthDate])

أو لإظهار التفاصيل للمدة المتبقية مع تاريخ سن التقاعد أو المعاش =

=CalculateRetirementInfo([TEmp_BirthDate])

سن التقاعد.accdb

**ابو جودي** · الإثنين at 00:00

4 ساعات مضت, أحمد العيسى said:

ولكن باستخدام أسلوب IIf

طيب انا بالفعل فى محاولتي الاولي استخدمت الاستعلام بالشكل التالي وزي ما حضرتك تفضلت تماما باستخدام أسلوب 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 مباشرة بدلا من الحساب التدريجي

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

4 ساعات مضت, أحمد العيسى said:

لكن من الجميل جداً أن يكون العمل من خلال دالة احترافية كما تفضلت هنا

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

4 ساعات مضت, أحمد العيسى said:

بالنسبة للبيانات الشاملة يفضل أن يكون الباقى على تاريخ المعاش مفصلاً

بالسنة والشهر واليوم كما فى الصور التالية

طيب بالنسبة لهذه الجزئيه نقوم بإعادة تطوير المثال المرفق مرة أخرى تدلل

اولا الكود الرئيسي لحساب سن التقاعد وكما أشرنا سابقا سوف يكون داخل وحده نمطيه باسم : 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

**ابو جودي** · الإثنين at 00:11

2 ساعات مضت, Foksh said:

ما دام الأمر متوسعاً إلى هذا الحد 😁 ، فهذه فكرتي المتواضعة البسيطة ، وتضم 3 طرق بشكل (مباشر وغير مباشر ) لتحقيق الهدف

طيب اولا شكرا على افكارك يا استاذ فؤش افندى

وسعيد جدا جدا جدا بمشاركة حضرتك

ثانيا اعتذر ان المشاركة أتت بعدك ولكن انا تقريبا بدأت كتابة المشاركة وتعديل الكود بالتطويرات الجديده تقريبا من الساعه 11: 45 تقريبا ولو لاحظت هتلاقينى ذكرت فى المشاركة

1 ساعه مضت, ابو جودي said:

التاريخ الحالي: 23 مارس 2025 (بناءً على تاريخ اليوم للمشاركة الحالية )

فطبعا اعتذر ان جائت المشاركة بعد مشاركتك دون الاشارة اليكم فيها

انت وضعت المشاركه وانا منشغل فى

التنسيق وتطوير الكود وتعديل المشاركة اثناء تطوير الكود والرد والمشاركة فى نفس الوقت على موضع أخر فى المنتدى فى نفس الوقت

وطبعا لو اردنا النتائج فى مرفقى المتواضع تظهر بشكل مباشر مع تغيير السجلات

يمكن فقط ان يكون الكود التالى فى حدث الحالى للنموذج

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

**Foksh** · الإثنين at 00:16

2 دقائق مضت, ابو جودي said:

فطبعا اعتذر ان جائت المشاركة بعد مشاركتك دون الاشارة اليكم فيها

لا حاجة للإعتذار ، وانما يسعدني مشاركتك الأفكار ..

:wub:

**ابو جودي** · الإثنين at 00:17

4 دقائق مضت, Foksh said:

وانما يسعدني مشاركتك الأفكار ..

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

أحمد العيسى · الإثنين at 08:27

إنفجار بعد الإفطار فى كتابة الأكواد .. نصيحة خد لك ساتر

شكراً أبو جودي على كل إبداعاتك

لكن لى ملاحظة عن قانون 2019 بعيدة عن الأكواد

عندما تبحث فى جوجل عن "جدول خروج الموظفين على المعاش"

تجد الكثير جداً من هذا الجدول

والقليل _ يكاد لا يذكر _ من هذه الصورة

والسؤال لذوى الإختصاص :

أيهما الصحيح 1 / 1 أم 1 / 7

تم تعديل الإثنين at 08:28 بواسطه أحمد العيسى

**ابو جودي** · الإثنين at 12:38

في 24‏/3‏/2025 at 10:27, أحمد العيسى said:

إنفجار بعد الإفطار فى كتابة الأكواد .. نصيحة خد لك ساتر

شكراً أبو جودي

سبحانك لا علم لنا الا ما علمتنا انك انت الحكيم العليم كل الفضل والشكر لله سبحانه وتعالى الذى هدانا وما كنا لنهتدى لو لا ان هدانا الله عزوجل

هذا فضل الله ثم اساتذتنا العظماء الذين نتعلم منهم وعلى اياديهم

انا مجرد سبب فقط لا اكثر من ذلك و لا اقل :yes:

في 24‏/3‏/2025 at 10:27, أحمد العيسى said:

لكن لى ملاحظة عن قانون 2019 بعيدة عن الأكواد

عندما تبحث فى جوجل عن "جدول خروج الموظفين على المعاش"

تجد الكثير جداً من هذا الجدول

والسؤال لذوى الإختصاص :

أيهما الصحيح 1 / 1 أم 1 / 7

اعتقد والله اعلم أن 7/1 هو الصحيح اولا هو الموجود فى ملف الاكسل المرفق للاستاذ @Lotfy14

ثانيا شهر 7 هو بداية العام المالى الجديد لذلك هو اوقع من شهر 1 من وجهة نظرى المتواضعة

ثالثا عندما أبحث على الانترنت لا اعتمد الا النتائج من المصادر الموثوقة مثل الدستور مثلا

وهاكم رابط المصدر الذى استندت اليه

https://www.dostor.org/4831633

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

Lotfy14 · منذ 23 ساعات

الاستاذ ( Foksh ) والدينمو ( ابو جودي ) الفاضل ( أحمد العيسى )

*- الفاضل ( أحمد العيسى )

شكرا لمرورك ولتوضيحك بالتركيز على القانون

اعتقد ان اخى ( ابو جودى ) رد عليك الرد الانسب وبالدليل والمصدر ( واضح انه داااايس فى الشغل المالى ) كمان 😆

واللى اشتغل الشغل المالى عارف السنة المالية بداية من 1-7 وحتى 30-6 وفقا للقانون المصرى

والتأمينات الاجتماعية والمعاشات وفقا للمادة رقم 41 من قانون المعاشات 148 لسنة 2019

*- اخى الفاضل Foksh

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

دايما كدا الواحد بيتعرف على ناس محترمة بيبقى ساعيد انه بيحاولوا يحل ليه المشاكل اللى بيقبلىها ،،، الف مليون شكر ،،،

*- الدينمو ابو جودي

تعاله انت بقى سيبك للاخر علشان ليك روقه معايا

دينمو المديول والمنتدى مشاء الله عليك وعلى طولة بالك الجاااامده دا ,,, لا صعيد بجد 😂

مجهود رااائع وكالعادة منبهر بافكارك السريعه

عاوز بقى اضيف حاجة

لما عرضت الطلب فى المنتدى وضحت ان تاريخ سن التقاعد مختلف

بمعنى اللى قبل التاريخ ميلاده 1970 هيخرج على الــ 60

ومن 1-7-1970 هيبتدى ينطبق القانون الجديد

فمن الطبيعى عندى موظفين مواليد قبل التاريخ دا وبعده كمان

اللى قبل القانون هيخرج على الــ 60 واللى بعد التاريخ ( القانون الجديد ) هيخرج كل واحد على حسب الجدول المعلن من التامين والمعاشات

اعتقد الفكرة كدا واصلة للجميع ( على المديول بتاعك فيه التركاية دى ) ؟؟؟؟ هنجرب ونشوف

فى حاجة مهمة جدا ودى لحبيبى ( ابو جودي )

البنى آدم الطبيعى العاقل واللى مذكور فى بطاقته انه يعمل لدى كذا مثلا 😂

لما بيجى يخرج معاش بيخرج قبل يوم مولده بيوم _ بمعنى

تاريخ ميلادى 14-6 لما اجى اخرج معاش هخرج 13-6 ادعيلى بقا نخرج على رجلينا

لاحظ الموضوع دا فى النماذج بتعتك المرفقة واللى ظبطها باليوم الاستاذ ( Foksh ) لاحظ النموذج بتاعه وانت هتعرف

متشكر جدا يا دينمو المنتدى ومستنى التعديل

أحمد العيسى · منذ 18 ساعات

5 ساعات مضت, Lotfy14 said:

تاريخ ميلادى 14-6 لما اجى اخرج معاش هخرج 13-6

منطقياً كلام صحيح ..

لكن ما يتم إعلانه فى كل الإدارات

أن يوم وشهر تاريخ الميلاد هو نفسه يوم وشهر استحقاق المعاش

تم تعديل منذ 18 ساعات بواسطه أحمد العيسى

أحمد العيسى · منذ 18 ساعات

نظراً لضيق الوقت واختلاف المتغيرات بين أكواد ملف أخونا الحبيب ابو جودي ، وتطبيقى المتواضع

فقد احتفظت بالملف كمرجع ، واستخدمت فى التطبيق دالة IIf فى مربع نص باسم Retirement

=IIf([birth]<#01/07/1971#;DateAdd("yyyy";60;[birth]);IIf(([birth]<#01/07/1972#);DateAdd("yyyy";61;[birth]);IIf(([birth]<#01/07/1973#);DateAdd("yyyy";62;[birth]);IIf(([birth]<#01/07/1974#);DateAdd("yyyy";63;[birth]);IIf(([birth]<#01/07/1975#);DateAdd("yyyy";64;[birth]);IIf([birth]>=#01/07/1975#;DateAdd("yyyy";65;[birth])))))))

حيث birth هو تاريخ الميلاد

ثم أنشأت مربع نص جديد لحساب سن التقاعد ووضعت به :

=Year([Retirement])-Year([birth])

تم تعديل منذ 16 ساعات بواسطه أحمد العيسى

**ابو جودي** · منذ 14 ساعات

15 ساعات مضت, Lotfy14 said:

لما عرضت الطلب فى المنتدى وضحت ان تاريخ سن التقاعد مختلف

بمعنى اللى قبل التاريخ ميلاده 1970 هيخرج على الــ 60

ومن 1-7-1970 هيبتدى ينطبق القانون الجديد

فمن الطبيعى عندى موظفين مواليد قبل التاريخ دا وبعده كمان

اللى قبل القانون هيخرج على الــ 60 واللى بعد التاريخ ( القانون الجديد ) هيخرج كل واحد على حسب الجدول المعلن من التامين والمعاشات

اعتقد الفكرة كدا واصلة للجميع ( على المديول بتاعك فيه التركاية دى ) ؟؟؟؟ هنجرب ونشوف

تجرب ورايا تصدق زعلتنى يا راجل دا شغل فاخر من الاخر

15 ساعات مضت, Lotfy14 said:

البنى آدم الطبيعى العاقل

ايه اللى انت بتقوله ده هو انت شايفنى بنى ادم طبيعى واللا عاقل

عل كل حال تم تغير الوظيفه : 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

**ابو جودي** · منذ 14 ساعات

3 ساعات مضت, أحمد العيسى said:

نظراً لضيق الوقت واختلاف المتغيرات بين أكواد ملف أخونا الحبيب ابو جودي

ولا يهمك ده مرفقك بعد التعديل تدلل

بيانات المدرسين (1).zip

**ابو جودي** · منذ 6 ساعات

واتفضلوا هذا المرفق يعتمد فقط على الرقم القومى فى عمل كل شئ

اعتقد كده يا استاذ @Lotfy14 ويا استاذ @أحمد العيسى هذا المرفق الاخيــر يشمل كل التفاصيل من خلال الرقم القومى

الان الرقم القومى بمجرد كتابته يتم الحصول على كافة البيانات التالية

تاريخ الميلاد
الجنس
مكان الميلاد

العمر بالسنوات
العمر بالأشهر
العمر بالأيام

سن التقاعد
تاريخ التقاعد
السنوات المتبقية لبلوغ سن التقاعد
الأشهر المتبقية لبلوغ سن التقاعد
الأيام المتبقية لبلوغ سن التقاعد

مع المرونة المطلقه فى تغير قيمة المتعير

من يريد خصم اليوم يستخدم المتغير التالى
' تعيين قيمة التعديل
adjustmentDays = -1 ' طرح يوم واحد من تاريخ التقاعد

ومن لا يريد خصم يوم يستخدم المتغير بالشكل التالى
' تعيين قيمة التعديل
adjustmentDays = 0 عدم طرح او زياده اى يوم لتاريخ التقاعد

سن التقاعد (7).accdb

Lotfy14 · منذ 4 دقائق

افضل الاجابات ( اجابة شاااامله )

تسلم ايديك يا دينمو 😊

شغل متكلف وزنه ذهب ( تسلملى دماغك )

عملت المطلوب وزيادة قوى

حبيبى يا ( ابو جودي )

هحتاجك فى مشروعى فى حاجة تانية تخص الاكواد
بس كفايه عليك كدا فى رمضان احسن دماغك هتعمل error

نتقابل بعد العيد ان شاء الله

سعيد فى وجودك فى مواضيعى ويارب دايما نشوفك فى حلول الغير تقليدية

تسجيل الدخول

سن التقاعد ( القانون المصري ) حساب تاريخ سن المعاش تبعا لقانون التأمينات والمعاشات المصري الجديد 148 لعام 2019

الردود الموصى بها

Lotfy14

Foksh

ابو جودي

ابو جودي

أحمد العيسى

Foksh

ابو جودي

مقارنة النتائج (مثال واحد):

نتيجة الكود VBA:

نتيجة الاستعلام SQL:

النتيجة: الاستعلام أقل دقة في حساب الأشهر والأيام لأنه يعتمد علي DateDiff مباشرة بدلا من الحساب التدريجي

ابو جودي

Foksh

ابو جودي

أحمد العيسى

ابو جودي

Lotfy14

أحمد العيسى

أحمد العيسى

ابو جودي

ابو جودي

ابو جودي

Lotfy14

Join the conversation

محتوي مشابه

shellexecutor شخابيط و افكار : تنفيذ الأوامر والملفات في بيئة Windows مع تحكم دقيق في العمليات

أتمتة عمليات الضغط شخابيط و أفكار :أتمتة عمليات الضغط وفك الضغط للملفات و المجلدات (WinRAR / Seven Zip )

non-unicode شخابيط و افكار : ضبط وتعديل اللغة لدعمها فى البرامج غير الموحدة ( language for non-Unicode programs )

مُطَهَّرُ النُّصُوصِ الْعَرَبِيَّةِ شخابيط و افكار : مطهر النصوص و افضل حلول مشاكل التشكيل و الحركات

هدية : شخابيط و أفكار : إجراء مركزي لإدارة الأخطاء

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information