توزيع الايام الى ايام واشهر وسنوات

[سلمان الشهراني]

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

توزيع الايام الى تاريخ.accdb

[kkhalifa1960]

تفضل أخي @سلمان الشهراني . ووافني بالرد .

توزيع الايام الى تاريخ-1.rar

[ابوخليل]

مشاركة مع اخي وحبيبي الاستاذ خليفة

على اعتبار الشهر 30 يوما

Me.DateY = Me.Text1 \ 360
Me.DateM = (Me.Text1 Mod 360) \ 30
Me.DateD = Me.Text1 Mod 360 Mod 30

 

توزيع الايام الى تاريخ.rar

[kanory]

1 ساعه مضت, سلمان الشهراني said:

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

Private Sub com1_Click()
Call YMD(Me.Text1.Value)
End Sub
Function YMD(No As Integer) As Variant
    Dim Y As Long
    Dim M As Long
    Dim D As Long
    Y = Int(No / 365.25)
    M = Int((No - (Int(No / 365.25) * 365.25)) / 30.4375)
    D = No - ((Y * 365.25) + (M * 30.4375))
    YMD = Y & " years " & M & " months " & D & " days"
Me.DateD = D
Me.DateM = M
Me.DateY = Y
End Function

 

[سلمان الشهراني]

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

[Moosak]

ولمجرد المشاركة هذه فكرتي لتحويل الأيام إلى سنوات وشهور 🙂 

تعتمد الفكرة على إضافة عدد الأيام المعطى لتاريخ اليوم ثم يتم حساب الفترة بين التاريخين ( من تاريخ اليوم وحتى عدد الأيام المعطاه )

بدون الحاجة لافتراض أن الشهر 30 يوم ، بل يتم الحساب بعدد الأيام الفعلية للأشهر المقبلة.

Public Function DaysToYMD(NumberOfDays As Long) As String
'لتحويل الأيام إلى سنوات وشهور وأيام

    Dim EndDate As Date
    Dim years As Integer
    Dim months As Integer
    Dim days As Integer
    Dim intH As Integer
    
'إضافة عدد الأيام لليوم الحالي
    EndDate = DateAdd("d", NumberOfDays, Date)

' حساب المدة بين التاريخين
    intH = Int(DateDiff("m", Date, EndDate)) + _
              (EndDate < DateSerial(Year(EndDate), Month(EndDate), Day(Date)))
    
    years = Int(intH / 12)
    months = intH Mod 12
    
    days = DateDiff("d", DateAdd("m", intH, Date), EndDate)
    
    DaysToYMD = years & " سنة و " & months & " أشهر و " & days & " يوم"
    'MsgBox " المدة :     " & DaysToYMD
End Function

طريقة الاستخدام هكذا :

DaysToYMD(500)

 

[Moosak]

وهناك مشاركة في موضوع مشابه للباش مهندس محمد عصام @ابو جودي هنا: