درود.
این کد را به عنوان ماژول به آفیس اضافه کنید :
Option Explicit
Public Function JalaliToGregorian(jy As Integer, jm As Integer, jd As Integer) As String
Dim gy As Integer
Dim gm As Integer
Dim gd As Integer
Dim g_d_m(12) As Integer
Dim jy2 As Integer
Dim days As Long
g_d_m(0) = 0
g_d_m(1) = 31
g_d_m(2) = 59
g_d_m(3) = 90
g_d_m(4) = 120
g_d_m(5) = 151
g_d_m(6) = 181
g_d_m(7) = 212
g_d_m(8) = 243
g_d_m(9) = 273
g_d_m(10) = 304
g_d_m(11) = 334
If jy > 979 Then
gy = 1600
jy = jy - 979
Else
gy = 621
End If
If jm < 7 Then
days = (jm - 1) * 31
Else
days = ((jm - 7) * 30) + 186
End If
days = days + (365 * jy) + ((jy \ 33) * 8) + (((jy Mod 33) + 3) \ 4) + 78 + jd
gy = gy + (400 * (days \ 146097))
days = days Mod 146097
If days > 36524 Then
gy = gy + (100 * ((days - 1) \ 36524))
days = (days - 1) Mod 36524
If days >= 365 Then
days = days + 1
End If
End If
gy = gy + (4 * (days \ 1461))
days = days Mod 1461
If days > 365 Then
gy = gy + ((days - 1) \ 365)
days = (days - 1) Mod 365
End If
gd = days + 1
If ((gy Mod 4 = 0 And gy Mod 100 <> 0) Or (gy Mod 400 = 0)) Then
g_d_m(2) = 60
End If
For gm = 0 To 11
If gd <= g_d_m(gm + 1) Then Exit For
Next
gd = gd - g_d_m(gm)
gm = gm + 1
JalaliToGregorian = gy & "/" & Format(gm, "00") & "/" & Format(gd, "00")
End Function
نحوه استفاده :
=JalaliToGregorian(1405,3,2)










پاسخ با نقل قول