تحويل الأيام إلى سنة شهر يوم

**AbuuAhmed** · فبراير 3

في موضوع آخر هناك دوال لتأخذ تاريخين بداية ونهاية ثم ترجع المدة على شكل سنة شهر يوم
أما هذه الدالة تأخذ أيام فقط وتحولها إلى سنة شهر يوم، وهنا الدالة تفترض أن تاريخ البداية دائما هو بداية دورة الـ 400 سنة مثل:
1، 401، 801، 1201، 1601، 2001 وهكذا.

Function FixVal(inVal As Double, MinVal As Double, MaxVal As Double) As Double
    FixVal = inVal
    If inVal < MinVal Then FixVal = MinVal
    If inVal > MaxVal Then FixVal = MaxVal
End Function

Function Days2Period(ByVal Days As Long) As String
    Dim CurCal As VbCalendar
    Dim Gr2: Gr2 = Array(0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365, 396)
    Dim yy As Long, mm As Integer, dd As Integer
    Dim Cyc400 As Long, Cyc100 As Long, Cyc004 As Long, Cyc001 As Long
    Dim mmDays As Double, Leap As Byte
  
    CurCal = Calendar
    Calendar = vbCalGreg
  
    Cyc400 = Fix(Days / 146097):              Days = Days - Cyc400 * 146097
    Cyc100 = FixVal(Fix(Days / 36524), 0, 3): Days = Days - Cyc100 * 36524
    Cyc004 = FixVal(Fix(Days / 1461), 0, 24): Days = Days - Cyc004 * 1461
    Cyc001 = FixVal(Fix(Days / 365), 0, 3):   Days = Days - Cyc001 * 365
    
    yy = Cyc400 * 400 + Cyc100 * 100 + Cyc004 * 4 + Cyc001
    mm = FixVal(Round(Days / 29.5, 0), 0, 11)
  
    Leap = Day(DateSerial(yy + 1, 3, 0)) - 28
    mmDays = Gr2(mm) + IIf(mm > 1, Leap, 0)
    Do While mmDays > Days
        mm = mm - 1
        mmDays = Gr2(mm) + IIf(mm > 1, Leap, 0)
    Loop
  
    dd = Days - mmDays
    Days2Period = Format(yy, "00") & "-" & Format(mm, "00") & "-" & Format(dd, "00")
  
    Calendar = CurCal
End Function

Days_to_Year_Month_Day_01.xlsm