تحويل التقويم الميلادى الى التقويم القبطى-convert the Christmas calendar to the Coptic calendar

[Ali Mohamed Ali]

السلام عليكم اساتذتى الكرام اود ان اقدم لكم اليوم دالة أعجبتنى -وتقوم هذه الدالة بتحويل التقويم الميلادى الى التقويم القبطى

ومن هنا لابد ان نعرف التقويم القبطى ولابد ان نقول نبذة عنه

تبدأ السنة الجديدة عادة في 29 أغسطس، عدا السنة التي تسبق السنة الكبيسة حيث تبدأ في 30 أغسطس.

للحصول على رقم السنة القبطية، يُطرح من رقم السنة اليوليانية إما 283 (قبل السنة اليوليانية الجديدة) أو 284 (بعدها).

ويتكون التقويم القبطى من 13 شهر كالتالى :

وهذا هو كود الدالة المستخدمة فى تحويل التاريخ من الميلادى الى القبطى

Option Explicit
Function CopticDate(WkDate As Date) As String
Const YDiff = 284
Dim DateList As Object
Set DateList = CreateObject("System.Collections.Sortedlist")
Dim T, TT
Dim I As Integer, II As Integer
Dim WkY As Integer
Dim WkM As String
Dim WkD As Integer

With Sheets("Data")
For I = 1 To 13
T = Split(.Cells(I + 1, 3), "/")
DateList.Add DateSerial(Year(WkDate), T(1), T(0)) * 1, .Cells(I + 1, 4)
Next I
End With
WkY = Year(WkDate) - YDiff
With DateList
TT = WkDate * 1
If (TT >= .GetKey(.Count - 1)) Then
WkM = .GetByIndex(0)
WkD = TT - .GetKey(.Count - 1) + 1
Else
If (TT <= .GetKey(0)) Then
WkM = .GetByIndex(.Count - 1)
II = TT - DateSerial(Year(WkDate), 1, 1) ' FIRST day of the year = 101
WkD = DateSerial(Year(WkDate), 12, 31) - .GetKey(.Count - 1) + II ' LAST day of the year = 1231

Else
For I = 0 To 12
If ((TT > .GetKey(I)) And (TT <= .GetKey(I + 1))) Then
WkM = .GetByIndex(I + 1)
WkD = TT - .GetKey(I)
Exit For
End If
Next I
End If
End If
End With
CopticDate = WkM & "/ " & WkD & "/ " & WkY
End Function

وتستخدم بهذه المعادلة

=CopticDate()

 

 

convert the Christmas calendar to the Coptic calendar.xlsm

 

[حسين مامون]

جزاك الله خيرا وجعل هذا العمل  في ميزان حسناتك

[Ali Mohamed Ali]

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

[أحمد يوسف]

أحسنت استاذ علي عمل ممتاز جعله الله فى ميزان حسناتك