دالة التحويل بين التاريخين الهجري والميلادي .

[note] دالة تحويل التاريخ [/note]

 
'هذه الدالة تعمل التحويل من الهجري إلى الميلادي والعكس
' حسب المتغيرات التي تمررها
Function ConvertDateString( _
ByRef StringIn As String, _
ByRef OldCalendar As Integer, _
ByVal NewCalendar As Integer, _
ByRef NewFormat As String) As String
Dim SavedCal As Integer
Dim d As Date
Dim s As String
'// Save VBA Calendar setting to restore when finished
SavedCal = Calendar
'// Convert date to new calendar and format
Calendar = OldCalendar ' Change to StringIn calendar
d = CDate(StringIn) ' Convert from String to Date
Calendar = NewCalendar ' Change to calendar of new string
s = CStr(d) ' Convert to short format String
ConvertDateString = Format(s, NewFormat) 'Reformat
'// Restore VBA Calendar setting
Calendar = SavedCal
End Function
'***************************************
'هذه الدالة تحول من الميلادي الى الهجري
Function Hijri(Gregp As Variant) As String
Dim GregorianDate As String
Dim HijriDate As String
Dim HijriFormat As String
Dim Greg As String
Greg = CStr(Gregp)
GregorianDate = Greg ' Gregorian string to convert
HijriFormat = "Short Date" ' Format for Hijri date
'// Convert to Hijri date 7/8/1414 and return in Long Date format
HijriDate = ConvertDateString( _
GregorianDate, _
vbCalGreg, _
vbCalHijri, _
HijriFormat)
Hijri = HijriDate
End Function
'****************************************
'وهذه تحول من الهجري الى الميلادي
Function Gregori(HijriDatP As Variant) As String
Dim GregorianDate As String
Dim HijriDate As String
Dim HijriFormat As String
Dim HijriDat As String

HijriDat = CStr(HijriDatP)
GregorianDate = HijriDat ' Gregorian string to convert
HijriFormat = "Short Date" ' Format for Hijri date

'// Convert to Hijri date 7/8/1414 and return in Long Date format
HijriDate = ConvertDateString( _
GregorianDate, _
vbCalHijri, _
vbCalGreg, _
HijriFormat)
Gregori = HijriDate
End Function

[عدلت بواسطة ابو لمى ت:30-05-2001 س: 08:09 AM]