تبدیل تاریخ میلادی به شمسی

[Hadi_Goodarzi]

Public Function PersionDate()
Dim iFDay, iFMounth, iFYear, iFdayOfYear
Dim iYear, iDayOfYear
Dim iNumDayOfYear
Dim aiFMounthDays
aiFMounthDays = Array(31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 29)
iNumDayOfYear = 365
iYear = Year(Date)
iDayOfYear = DatePart("y", Date)
If IsLeapYear(iYear - 1) Then
iNumDayOfYear = 366
aiFMounthDays(11) = 30
End If
If (iDayOfYear > 79) Then
iFYear = iYear - 621
iFdayOfYear = iDayOfYear - 79
Else
iFYear = iYear - 622
iFdayOfYear = (iNumDayOfYear - 79) + iDayOfYear
End If
iFDay = iFdayOfYear
While (iFDay > aiFMounthDays(iFMounth))
iFDay = iFDay - aiFMounthDays(iFMounth)
iFMounth = iFMounth + 1
Wend
iFMounth = iFMounth + 1
If iFMounth < 10 Then iFMounth = "0" & iFMounth
If iFDay < 10 Then iFDay = "0" & iFDay
PersionDate = iFYear & "/" & iFMounth & "/" & iFDay
End Function
Private Function IsLeapYear(nYear)
IsLeapYear = (((nYear Mod 4) = 0 And (nYear Mod 100) <> 0) Or (nYear Mod 400) = 0)
End Function