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

اگر می‌خواهید در VBA اکسل یا اکسس تاریخ میلادی را به شمسی تبدیل کنید یا برعکس، در این آموزش یک ماژول کامل برای انجام این کار در اختیار شما قرار می‌گیرد. با استفاده از توابع این ماژول می‌توانید تاریخ میلادی را به تاریخ شمسی تبدیل کنید، تاریخ شمسی را به میلادی برگردانید، سال کبیسه شمسی را تشخیص دهید و اختلاف بین دو تاریخ شمسی را محاسبه کنید.

دو تابع اصلی این ماژول JalaliCalendar برای تبدیل تاریخ میلادی به شمسی و GregorianCalendar برای تبدیل تاریخ شمسی به میلادی هستند. این کد در محیط VBA اکسل و اکسس قابل استفاده است.

نکته: الگوریتم فعلی ماژول بر مبنای تاریخ 01-01-1300 شمسی برابر با 21-03-1921 میلادی طراحی شده و برای تاریخ‌های شمسی از سال 1300 به بعد در نظر گرفته شده است.

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

برای تبدیل یک تاریخ میلادی به شمسی از تابع JalaliCalendar استفاده می‌کنیم. آرگومان اول این تابع یک مقدار از نوع Date است و آرگومان دوم نوع خروجی را تعیین می‌کند.

Sub TestGregorianToJalali()

    Dim result As Variant

    result = JalaliCalendar(DateSerial(2024, 9, 5), jcNumber)

    MsgBox result

End Sub

خروجی مثال بالا برابر است با:

14030615

یعنی تاریخ میلادی 5 سپتامبر 2024 به تاریخ 15 شهریور 1403 تبدیل شده است.

اگر خروجی متنی شامل نام روز و ماه را بخواهید، می‌توانید از jcString استفاده کنید:

Sub TestGregorianToJalaliString()

    Dim result As Variant

    result = JalaliCalendar(DateSerial(2024, 9, 5), jcString)

    MsgBox result

End Sub

خروجی:

پنجشنبه 15 شهریور 1403

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

برای تبدیل تاریخ شمسی به میلادی از تابع GregorianCalendar استفاده می‌کنیم. تاریخ شمسی ورودی باید به صورت عددی و با قالب YYYYMMDD وارد شود.

برای مثال، تاریخ 15 شهریور 1403 به شکل 14030615 نوشته می‌شود:

Sub TestJalaliToGregorian()

    Dim gregorianDate As Date

    gregorianDate = GregorianCalendar(14030615, True)

    MsgBox Format(gregorianDate, "yyyy-mm-dd")

End Sub

خروجی:

2024-09-05

نحوه افزودن ماژول تبدیل تاریخ به Excel و Access

برای استفاده از این توابع، کد کامل ماژول را که در ادامه همین آموزش قرار گرفته است به پروژه VBA خود اضافه کنید.

1. در Excel یا Access کلیدهای Alt + F11 را فشار دهید تا محیط VBA باز شود.
2. از منوی Insert گزینه Module را انتخاب کنید.
3. کد کامل ماژول این صفحه را در ماژول جدید قرار دهید.
4. فایل را ذخیره کنید. در Excel باید از فرمتی مانند .xlsm استفاده کنید که قابلیت نگهداری ماکرو را داشته باشد.
5. اکنون می‌توانید توابع JalaliCalendar، GregorianCalendar و JCDateDiff را در کدهای VBA خود فراخوانی کنید.

ورودی و خروجی توابع تبدیل تاریخ

تابع JalaliCalendar

تابع JalaliCalendar یک تاریخ میلادی از نوع Date دریافت می‌کند:

JalaliCalendar(InputDate As Date, Optional returnValueType As jCalendar_returnValueType = jcString)

نوع خروجی با آرگومان returnValueType مشخص می‌شود:

• jcString: خروجی متنی، مانند پنجشنبه 15 شهریور 1403
• jcNumber: خروجی به شکل YYYYMMDD مانند 14030615
• jcSplitArray: رشته‌ای شامل روز، ماه و سال با جداکننده ! که می‌توان آن را با تابع Split به آرایه تبدیل کرد.

برای مثال:

Dim arrDate() As String

arrDate = Split(JalaliCalendar(Date, jcSplitArray), "!")

' arrDate(0) = روز
' arrDate(1) = ماه
' arrDate(2) = سال

تابع GregorianCalendar

تابع GregorianCalendar یک تاریخ شمسی عددی دریافت می‌کند:

GregorianCalendar(inJalaliDate As Long, jalaliDateToGregorian As Boolean)

برای تبدیل مستقیم تاریخ شمسی به میلادی، آرگومان دوم را برابر True قرار دهید:

GregorianCalendar(14030615, True)

ماژول تبدیل تاریخ چگونه کار می‌کند؟

این ماژول برای تبدیل تاریخ از یک تاریخ مبنا استفاده می‌کند. تاریخ 1 فروردین 1300 برابر با 21 مارس 1921 در نظر گرفته شده است. برای تبدیل تاریخ میلادی به شمسی ابتدا تعداد روزهای گذشته از تاریخ مبنا محاسبه می‌شود و سپس این تعداد روز به سال، ماه و روز شمسی تبدیل می‌شود.

برای تشخیص سال‌های کبیسه شمسی نیز از یک الگوریتم حسابی استفاده شده است. تعیین صحیح سال کبیسه اهمیت زیادی دارد، زیرا تعداد روزهای اسفند و در نتیجه تبدیل تاریخ به آن وابسته است.

تعاریف اولیه و نوع خروجی ماژول

در ابتدای ماژول متغیرهای مورد نیاز و یک Enum برای مشخص کردن نوع خروجی تابع تعریف می‌شوند:

Public Enum jCalendar_returnValueType
    jcSplitArray = 1
    jcNumber = 2
    jcString = 3
End Enum

تشخیص سال کبیسه شمسی با تابع JalaliKabise

تابع JalaliKabise با استفاده از یک الگوریتم حسابی مشخص می‌کند که سال شمسی ورودی کبیسه است یا خیر:

Public Function JalaliKabise(Yr As Integer) As Boolean

    calcYear = (Yr + 2346) * 0.24219858156
    calcYear = calcYear - Int(calcYear)

    If calcYear < 0.24219858156 Then
        JalaliKabise = True
    Else
        JalaliKabise = False
    End If

End Function

اطلاع از کبیسه بودن سال به‌خصوص برای تشخیص تعداد روزهای اسفند ضروری است.

تابع JalaliCalendar برای تبدیل میلادی به شمسی

تابع JalaliCalendar ابتدا اختلاف تعداد روز بین تاریخ میلادی ورودی و تاریخ مبنا را محاسبه می‌کند:

JCDaysCount = DateDiff("d", #3/21/1921#, InputDate) + 1
JCYear = 1300

سپس سال‌های کامل از تعداد روزها کم می‌شوند. در هر مرحله کبیسه بودن سال نیز بررسی می‌شود:

Do Until JCDaysCount < 365

    If JalaliKabise(JCYear) = True Then
        D = 366
    Else
        D = 365
    End If

    If JCDaysCount - D > 0 Then
        JCDaysCount = JCDaysCount - D
        JCYear = JCYear + 1
    Else
        Exit Do
    End If

Loop

بعد از مشخص شدن سال، روزهای باقی‌مانده به ماه و روز شمسی تبدیل می‌شوند. شش ماه اول تقویم شمسی 31 روز، پنج ماه بعد 30 روز و تعداد روزهای اسفند وابسته به کبیسه بودن سال است.

تابع GregorianCalendar برای تبدیل شمسی به میلادی

تابع GregorianCalendar ابتدا سال، ماه و روز را از عدد تاریخ شمسی استخراج می‌کند:

GCJalaliDay = Right(inJalaliDate, 2)
GCJalaliMonth = Mid(inJalaliDate, 5, 2)
GCJalaliYear = Left(inJalaliDate, 4)

سپس اعتبار تاریخ بررسی می‌شود؛ از جمله محدوده ماه، تعداد روزهای هر ماه و وضعیت سال کبیسه برای ماه اسفند.

پس از اعتبارسنجی، تعداد روزهای سپری‌شده از ابتدای سال 1300 محاسبه و به تاریخ مبنای میلادی اضافه می‌شود:

GCcalculateDate = DateAdd("d", GCDaysCount - 1, #3/21/1921#)

محاسبه اختلاف بین دو تاریخ شمسی در VBA

تابع JCDateDiff دو تاریخ شمسی را دریافت می‌کند، ابتدا آن‌ها را به تاریخ میلادی تبدیل می‌کند و سپس اختلاف تعداد روز بین دو تاریخ را با DateDiff محاسبه می‌کند.

Public Function JCDateDiff(firstDate As Long, secoundDate As Long)

    JCDateDiff = DateDiff("d", _
        GregorianCalendar(firstDate, True), _
        GregorianCalendar(secoundDate, True), _
        vbSaturday)

End Function

برای مثال:

Sub TestDateDifference()

    Dim days As Long

    days = JCDateDiff(14030101, 14030111)

    MsgBox days

End Sub

نمایش تاریخ امروز به شمسی

یکی از کاربردهای رایج ماژول، نمایش تاریخ روز سیستم به صورت شمسی است:

Sub ShowTodayJalali()

    Dim todayJalali As String

    todayJalali = JalaliCalendar(Date, jcString)

    MsgBox "امروز: " & todayJalali

End Sub

کد کامل ماژول تبدیل تاریخ شمسی و میلادی در VBA

کد زیر نسخه کامل ماژول است. برای استفاده، آن را در یک Standard Module در محیط VBA قرار دهید.

Option Explicit

'==============================================================
' هدف ماژول: تبدیل تاریخ شمسی به میلادی و بالعکس
' تاریخ مبنای شمسی: 01-01-1300
' تاریخ مبنای میلادی: 21-03-1921
' محدوده طراحی‌شده: تاریخ‌های شمسی از سال 1300 به بعد
'==============================================================

Dim calcYear As Variant
Dim D As Integer
Dim JCDaysCount As Long
Dim JCMonth As Integer
Dim JCYear As Integer
Dim JCRemainDays As Integer
Dim bytDayOfWeek As Byte
Dim strFaMonth As String
Dim strFaDay As String

Dim GCYear As Integer
Dim GCDaysCount As Long
Dim GCMonth As Integer
Dim GCYearNow As Integer
Dim GCDayNow As Integer
Dim GCMonthNow As Integer
Dim GCJalaliNow As String
Dim arrGCJalaliNow() As String
Dim GCcalculateDate As Date
Dim GCJalaliDay As Integer
Dim GCJalaliMonth As Integer
Dim GCJalaliYear As Integer

Dim strJCMonth As String
Dim strJCRemainDays As String

Public Enum jCalendar_returnValueType
    jcSplitArray = 1
    jcNumber = 2
    jcString = 3
End Enum


Public Function JalaliKabise(Yr As Integer) As Boolean

    calcYear = (Yr + 2346) * 0.24219858156
    calcYear = calcYear - Int(calcYear)

    If calcYear < 0.24219858156 Then
        JalaliKabise = True
    Else
        JalaliKabise = False
    End If

End Function


'==============================================================
' تبدیل تاریخ میلادی به شمسی
'
' InputDate:
'   تاریخ میلادی از نوع Date
'
' returnValueType:
'   jcString     = خروجی متنی
'   jcNumber     = خروجی به شکل YYYYMMDD
'   jcSplitArray = رشته روز!ماه!سال برای استفاده با Split
'==============================================================

Public Function JalaliCalendar( _
    InputDate As Date, _
    Optional returnValueType As jCalendar_returnValueType = jcString _
) As Variant

    JCDaysCount = DateDiff("d", #3/21/1921#, InputDate) + 1
    JCYear = 1300

    Do Until JCDaysCount < 365

        If JalaliKabise(JCYear) = True Then
            D = 366
        Else
            D = 365
        End If

        If JCDaysCount - D > 0 Then
            JCDaysCount = JCDaysCount - D
            JCYear = JCYear + 1
        Else
            Exit Do
        End If

    Loop

    JCRemainDays = JCDaysCount

    If JCRemainDays <= 31 Then
        JCMonth = 1
    End If

    If JCRemainDays > 31 And JCRemainDays <= 186 Then

        JCMonth = 1

        Do Until JCRemainDays <= 31
            JCRemainDays = JCRemainDays - 31
            JCMonth = JCMonth + 1
        Loop

    End If

    If JCRemainDays > 186 And JCRemainDays <= 336 Then

        JCMonth = 7
        JCRemainDays = JCRemainDays - 186

        Do Until JCRemainDays <= 30
            JCRemainDays = JCRemainDays - 30
            JCMonth = JCMonth + 1
        Loop

    End If

    If JCRemainDays > 336 And JCRemainDays < 365 Then
        JCMonth = 12
        JCRemainDays = JCRemainDays - 336
    End If

    If JCRemainDays = 365 Then
        JCMonth = 12
        JCRemainDays = 29
    End If

    If JCRemainDays = 366 Then

        If JalaliKabise(JCYear) = True Then
            JCMonth = 12
            JCRemainDays = 30
        Else
            JCMonth = 1
            JCRemainDays = 1
            JCYear = JCYear + 1
        End If

    End If

    bytDayOfWeek = Format(InputDate, "w", vbSaturday)

    If returnValueType = jcSplitArray Then
        JalaliCalendar = JCRemainDays & "!" & JCMonth & "!" & JCYear
        Exit Function
    End If

    If returnValueType = jcNumber Then

        If JCMonth < 10 Then
            strJCMonth = 0 & JCMonth
        Else
            strJCMonth = JCMonth
        End If

        If JCRemainDays < 10 Then
            strJCRemainDays = 0 & JCRemainDays
        Else
            strJCRemainDays = JCRemainDays
        End If

        JalaliCalendar = JCYear & strJCMonth & strJCRemainDays
        Exit Function

    End If

    Select Case JCMonth
        Case 1
            strFaMonth = "فروردین"
        Case 2
            strFaMonth = "اردیبهشت"
        Case 3
            strFaMonth = "خرداد"
        Case 4
            strFaMonth = "تیر"
        Case 5
            strFaMonth = "مرداد"
        Case 6
            strFaMonth = "شهریور"
        Case 7
            strFaMonth = "مهر"
        Case 8
            strFaMonth = "آبان"
        Case 9
            strFaMonth = "آذر"
        Case 10
            strFaMonth = "دی"
        Case 11
            strFaMonth = "بهمن"
        Case 12
            strFaMonth = "اسفند"
    End Select

    Select Case bytDayOfWeek
        Case 1
            strFaDay = "شنبه"
        Case 2
            strFaDay = "یکشنبه"
        Case 3
            strFaDay = "دوشنبه"
        Case 4
            strFaDay = "سه‌شنبه"
        Case 5
            strFaDay = "چهارشنبه"
        Case 6
            strFaDay = "پنجشنبه"
        Case 7
            strFaDay = "جمعه"
    End Select

    If returnValueType = jcString Then
        JalaliCalendar = strFaDay & " " & _
                         JCRemainDays & " " & _
                         strFaMonth & " " & _
                         JCYear
    End If

End Function


'==============================================================
' تبدیل تاریخ شمسی به میلادی
'
' inJalaliDate:
'   تاریخ شمسی به فرم YYYYMMDD
'   مثال: 14030615
'
' برای تبدیل مستقیم شمسی به میلادی:
'   jalaliDateToGregorian = True
'==============================================================

Public Function GregorianCalendar( _
    inJalaliDate As Long, _
    jalaliDateToGregorian As Boolean _
) As Variant

    GCJalaliDay = Right(inJalaliDate, 2)
    GCJalaliMonth = Mid(inJalaliDate, 5, 2)
    GCJalaliYear = Left(inJalaliDate, 4)

    ' اعتبارسنجی اولیه
    If GCJalaliDay > 31 Or GCJalaliMonth > 12 Then
        GregorianCalendar = "False"
        MsgBox "تاریخ ورودی اشتباه است.", vbCritical
        Exit Function
    End If

    If GCJalaliDay = 0 Or _
       GCJalaliMonth = 0 Or _
       GCJalaliYear < 1300 Then

        GregorianCalendar = "False"
        MsgBox "تاریخ ورودی اشتباه است.", vbCritical
        Exit Function

    End If

    If GCJalaliMonth > 6 Then

        If GCJalaliDay > 30 Then
            GregorianCalendar = "False"
            MsgBox "تاریخ ورودی اشتباه است.", vbCritical
            Exit Function
        End If

    End If

    If GCJalaliMonth = 12 Then

        If JalaliKabise(GCJalaliYear) = False Then

            If GCJalaliDay > 29 Then
                GregorianCalendar = "False"
                MsgBox "تعداد روزهای اسفند به‌درستی وارد نشده است.", vbCritical
                Exit Function
            End If

        End If

    End If

    ' محاسبه تعداد روزها از ابتدای سال 1300
    GCDaysCount = 0
    GCYear = 1300

    Do Until GCYear = GCJalaliYear

        If JalaliKabise(GCYear) = True Then
            D = 366
        Else
            D = 365
        End If

        GCDaysCount = GCDaysCount + D
        GCYear = GCYear + 1

    Loop

    ' تبدیل ماه‌های سپری‌شده به تعداد روز
    GCMonth = GCJalaliMonth - 1

    If GCMonth <> 0 Then

        Select Case GCMonth
            Case 1
                GCDaysCount = GCDaysCount + 31
            Case 2
                GCDaysCount = GCDaysCount + 62
            Case 3
                GCDaysCount = GCDaysCount + 93
            Case 4
                GCDaysCount = GCDaysCount + 124
            Case 5
                GCDaysCount = GCDaysCount + 155
            Case 6
                GCDaysCount = GCDaysCount + 186
            Case 7
                GCDaysCount = GCDaysCount + 216
            Case 8
                GCDaysCount = GCDaysCount + 246
            Case 9
                GCDaysCount = GCDaysCount + 276
            Case 10
                GCDaysCount = GCDaysCount + 306
            Case 11
                GCDaysCount = GCDaysCount + 336
        End Select

    End If

    GCDaysCount = GCDaysCount + GCJalaliDay

    GCcalculateDate = DateAdd( _
        "d", _
        GCDaysCount - 1, _
        #3/21/1921# _
    )

    If jalaliDateToGregorian = True Then
        GregorianCalendar = GCcalculateDate
        Exit Function
    End If

    ' تبدیل تاریخ امروز به شمسی
    GCJalaliNow = JalaliCalendar(Now, jcSplitArray)
    arrGCJalaliNow = Split(GCJalaliNow, "!")

    GCDayNow = arrGCJalaliNow(0)
    GCMonthNow = arrGCJalaliNow(1)
    GCYearNow = arrGCJalaliNow(2)

    ' جلوگیری از ورود تاریخ آینده در این حالت تابع
    If GCYearNow < GCJalaliYear Then
        MsgBox "تاریخ آینده نمی‌تواند وارد شود.", vbCritical
        GregorianCalendar = "False"
        Exit Function
    End If

    If GCYearNow = GCJalaliYear Then

        If GCMonthNow < GCJalaliMonth Then
            MsgBox "تاریخ آینده نمی‌تواند وارد شود.", vbCritical
            GregorianCalendar = "False"
            Exit Function
        End If

    End If

    If GCYearNow = GCJalaliYear Then

        If GCMonthNow = GCJalaliMonth Then

            If GCDayNow < GCJalaliDay Then
                MsgBox "تاریخ آینده نمی‌تواند وارد شود.", vbCritical
                GregorianCalendar = "False"
                Exit Function
            End If

        End If

    End If

    GregorianCalendar = JalaliCalendar( _
        GCcalculateDate, _
        jcString _
    )

End Function


'==============================================================
' محاسبه اختلاف تعداد روز بین دو تاریخ شمسی
'==============================================================

Public Function JCDateDiff( _
    firstDate As Long, _
    secoundDate As Long _
)

    JCDateDiff = DateDiff( _
        "d", _
        GregorianCalendar(firstDate, True), _
        GregorianCalendar(secoundDate, True), _
        vbSaturday _
    )

End Function

ویدیوی آموزش استفاده از ماژول در اکسل

در ویدیوی زیر نحوه انتقال ماژول به Excel و استفاده از توابع تبدیل تاریخ در VBA و سلول‌های اکسل را مشاهده می‌کنید.

ماژول آماده تاریخ شمسی VBA

اگر در پروژه خود به یک ماژول آماده برای کار با تاریخ شمسی نیاز دارید و نمی‌خواهید تمام منطق تبدیل تاریخ را از ابتدا پیاده‌سازی کنید، می‌توانید صفحه محصول ماژول تاریخ شمسی VBA را نیز بررسی کنید.

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

چگونه تاریخ میلادی را در VBA به شمسی تبدیل کنیم؟

یک مقدار از نوع Date را به تابع JalaliCalendar ارسال کنید. برای مثال JalaliCalendar(Date, jcNumber) تاریخ امروز سیستم را به شکل شمسی YYYYMMDD برمی‌گرداند.

فرمت تاریخ شمسی ورودی چیست؟

تابع GregorianCalendar تاریخ شمسی را به صورت عدد هشت‌رقمی YYYYMMDD دریافت می‌کند. برای مثال 15 شهریور 1403 باید به صورت 14030615 وارد شود.

آیا این کد در Excel و Access قابل استفاده است؟

بله. ماژول در محیط VBA قابل استفاده است و می‌توانید آن را در یک Standard Module در پروژه‌های Excel و Access قرار دهید.

آیا jcSplitArray واقعاً آرایه برمی‌گرداند؟

خیر. با وجود نام آن، خروجی این حالت یک رشته به شکل روز!ماه!سال است. برای تبدیل این رشته به آرایه باید از تابع Split استفاده کنید.

آیا این نسخه تاریخ‌های قبل از سال 1300 شمسی را پشتیبانی می‌کند؟

این پیاده‌سازی بر مبنای 1 فروردین 1300 طراحی شده و در تابع تبدیل شمسی به میلادی نیز سال‌های کمتر از 1300 نامعتبر در نظر گرفته شده‌اند.

جمع‌بندی

در این آموزش یک ماژول VBA برای تبدیل تاریخ میلادی به شمسی و شمسی به میلادی بررسی کردیم. تابع JalaliCalendar تاریخ میلادی را به شمسی تبدیل می‌کند و تابع GregorianCalendar امکان تبدیل تاریخ شمسی با قالب YYYYMMDD به تاریخ میلادی را فراهم می‌کند.

علاوه بر تبدیل تاریخ، تابع JalaliKabise برای تشخیص سال کبیسه و تابع JCDateDiff برای محاسبه اختلاف تعداد روز بین دو تاریخ شمسی در ماژول قرار گرفته‌اند. به این ترتیب می‌توانید همین ماژول را به‌عنوان پایه مدیریت تاریخ شمسی در پروژه‌های VBA اکسل و اکسس خود استفاده کنید.