Blog

Converting dates between different calendars is a common need in programming, especially for developers working with Iranian systems. In this tutorial post, we will review a complete and professional module for converting Persian (Jalali) dates to Gregorian (Miladi) dates and vice versa.

Introduction and Module Overview

This module, named DateConvertor, is designed for use in the VBA Access environment and enables accurate date conversion between the Persian and Gregorian calendars. The module uses a Gregorian base year (21-03-1921) to calculate the Persian date. The base date is considered in both Persian and Gregorian formats, and the time difference between the Gregorian base year and the input Gregorian date is calculated as the number of days. Then, using a loop and based on the Computational Arithmetic Calendar algorithm designed by Mousa Akrami, it determines whether the Persian year is a leap year or not, and then converts the number of days back to the Persian year, month, and day.

Option Explicit
'=============================================================='
'Module Purpose: Convert Persian dates to Gregorian and vice versa'
'Creation Date: 18-05-1397 (08-09-2018)'
'Persian Date Origin: 01-01-1300'
'Gregorian Date Origin: 21-03-1921'
'=============================================================='

General Structure and Initial Definitions

The module begins with the definition of global variables and an Enum for the output type:

Dim calcYear As Variant
Dim JCDaysCount As Long
Dim JCMonth As Integer
Dim JCYear As Integer
Dim JCRemainDays As Integer
'... and other variables
Enum jCalendar_returnValueType jcSplitArray = 1 'Output as Array' jcNumber = 2 'Output as Number' jcString = 3 'Output as String'
End Enum

Function to Detect Persian Leap Year

The first important function is the leap year detection function, which works based on astronomical calculations:

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

This function uses a precise mathematical algorithm to determine whether the input Persian year is a leap year or not.

Function to Convert Gregorian to Persian (JalaliCalendar)

The main function for converting Gregorian dates to Persian is the JalaliCalendar function. This function takes two arguments named InputDate and returnValueType. The InputDate argument is the input Gregorian date and its data type must be Date. The returnValueType argument is of the custom data type jCalendar_returnValueType, which is an Enum and can have three values: jcSplitArray, jcNumber, and jcString. It has three main stages for converting a Gregorian date to Persian:

Stage 1: Calculate Days Passed from the Origin

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

Stage 2: Convert Days to Persian Year

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

Stage 3: Convert to Persian Month and Day

' For the first 6 months of the year (31 days)
If (JCRemainDays > 31 And JCRemainDays <= 186) Then JCMonth = 1 Do Until JCRemainDays <= 31 JCRemainDays = JCRemainDays - 31 JCMonth = JCMonth + 1 Loop
End If

Function to Convert Persian to Gregorian

This function also has similar but reverse stages:

Stage 1: Extract Date Components

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

Stage 2: Validate Input Date

' Control day and month range
If GCJalaliDay > 31 Or GCJalaliMonth > 12 Then GregorianCalendar = "False" Exit Function
End If
' Control days of Esfand month
If GCJalaliMonth = 12 Then If JalaliKabise(GCJalaliYear) = False Then If GCJalaliDay > 29 Then GregorianCalendar = "False" Exit Function End If End If
End If

How to Use the Functions

The input date format for the functions must be YYYYMMDD. Example: 14030615 for the date 15 Shahrivar 1403.

Possible Output Types

' 1. String output
Dim strDate As String
strDate = JalaliCalendar(Date, jcString) ' Result: "Saturday 15 Shahrivar 1403" ' 2. Numeric output
Dim numDate As Long
numDate = JalaliCalendar(Date, jcNumber) ' Result: 14030615 ' 3. Array output
Dim arrDate() As String
arrDate = Split(JalaliCalendar(Date, jcSplitArray), "!") ' Result: Array containing "15", "6", "1403"

Practical Examples

Example 1: Display Today’s Date in Persian

Sub ShowTodayJalali() Dim todayJalali As String todayJalali = JalaliCalendar(Date, jcString) MsgBox "Today: " & todayJalali
End Sub

Example 2: Convert Persian Date to Gregorian

Sub ConvertToGregorian() Dim jalaliDate As Long Dim gregorianDate As Date jalaliDate = 14030615 ' 15 Shahrivar 1403 gregorianDate = GregorianCalendar(jalaliDate, True) MsgBox "Gregorian Date: " & Format(gregorianDate, "dd/mm/yyyy")
End Sub

Example 3: Calculate Age

Function CalculateAge(birthDate As Long) As Integer Dim todayJalali As Long todayJalali = JalaliCalendar(Date, jcNumber) Dim age As Integer age = (todayJalali - birthDate) \ 10000 CalculateAge = age
End Function

Complete Module Code

Option Explicit
'=============================================================='
'module target: convert Jalali date to Gregorian and vice versa'
'module created by Sadegh Abshenas''''''''''''''''''''''''''''''
'Jalali base date: 01-01-1300'''''''''''''''''''''''''''''''''''
'Gregorian base date: 21-03-1921''''''''''''''''''''''''''''''''
'=============================================================='
Dim calcYear As Variant
Dim j As Integer
Dim bytDay As Byte
Dim bytMonth As Byte
Dim intYear As Integer
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
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 'MsgBox "This year is a leap year" JalaliKabise = True Else 'MsgBox "This year is not a leap year" JalaliKabise = False End If End Function '---------------------------------------------------------------------- 'important note for JalaliCalendar Function: inputArgs help 'there is two method to work with this function 'method 1: input date must seprate into day, month and year 'on this method first 3 Args must fill and bolDateFormat set to false 'returnValueType just change return value format, if set to true return 'value seprate into string variable with ! as Separator 'method 2: a date variable set as input value (last args) 'on this method last 2 args must fill and bolDateFormat must set to true '---------------------------------------------------------------------- Public Function JalaliCalendar(InputDate As Date, Optional returnValueType As jCalendar_returnValueType = jcString) As Variant ' Calculate the difference in days between the calculation origin date and the input date of the function JCDaysCount = DateDiff("d", #3/21/1921#, InputDate) + 1 'JCDaysCount = DateDiff("d", #3/21/2010#, Now) + 1 'note Calculate days from origin date to today based on Gregorian JCYear = 1300 'note Persian calendar origin year 'note In the first stage, the days passed from the Gregorian origin must be converted to Persian year, day, and month. Do Until JCDaysCount < 365 'note Loop until the calculated days from the origin are less than 365 If JalaliKabise(JCYear) = True Then 'note Check for leap year for each year D = 366 'note Days in a leap year Else D = 365 'note Days in a non-leap year End If If JCDaysCount - D > 0 Then 'note If the difference in days equals one year, we should exit the loop JCDaysCount = JCDaysCount - D 'note Subtract the year's days from the total days passed from the origin and add one year to the year number 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 = "Farvardin" Case 2 strFaMonth = "Ordibehesht" Case 3 strFaMonth = "Khordad" Case 4 strFaMonth = "Tir" Case 5 strFaMonth = "Mordad" Case 6 strFaMonth = "Shahrivar" Case 7 strFaMonth = "Mehr" Case 8 strFaMonth = "Aban" Case 9 strFaMonth = "Azar" Case 10 strFaMonth = "Dey" Case 11 strFaMonth = "Bahman" Case 12 strFaMonth = "Esfand" End Select Select Case bytDayOfWeek Case 1 strFaDay = "Saturday" Case 2 strFaDay = "Sunday" Case 3 strFaDay = "Monday" Case 4 strFaDay = "Tuesday" Case 5 strFaDay = "Wednesday" Case 6 strFaDay = "Thursday" Case 7 strFaDay = "Friday" End Select If returnValueType = jcString Then JalaliCalendar = strFaDay & " " & JCRemainDays & " " & strFaMonth & " " & JCYear End If End Function
Public Function GregorianCalendar(inJalaliDate As Long, jalaliDateToGregorian As Boolean) As Variant GCJalaliDay = Right(inJalaliDate, 2) GCJalaliMonth = Mid(inJalaliDate, 5, 2) GCJalaliYear = Left(inJalaliDate, 4) 'note Initial controls for month and day '-------------------------------------------------------------------------- If GCJalaliDay > 31 Or GCJalaliMonth > 12 Then GregorianCalendar = "False" MsgBox "Input date is incorrect", vbCritical Exit Function End If If GCJalaliDay = 0 Or GCJalaliMonth = 0 Or GCJalaliYear < 1300 Then 'note Initial controls for month and day GregorianCalendar = "False" MsgBox "Input date is incorrect", vbCritical Exit Function End If If GCJalaliMonth > 6 Then 'note Control input days of the function based on the input month If GCJalaliDay > 30 Then GregorianCalendar = "False" MsgBox "Input date is incorrect", vbCritical Exit Function End If End If If GCJalaliMonth = 12 Then 'note Control days of Esfand month for non-leap years to not exceed 29 days If JalaliKabise(GCJalaliYear) = False Then If GCJalaliDay > 29 Then GregorianCalendar = "False" MsgBox "The number of days for Esfand month has not been entered correctly", vbCritical Exit Function End If End If End If '-------------------------------------------------------------------------- 'note End of initial controls 'note Start of date conversion to days 'note In the first stage, the days passed from the Persian calendar origin must be calculated 'note The considered Persian calendar origin is the beginning of the year 1300 GCDaysCount = 0 GCYear = 1300 Do Until GCYear = GCJalaliYear If JalaliKabise(GCYear) = True Then 'note Check for leap year for each year D = 366 'note Days in a leap year Else D = 365 'note Days in a non-leap year End If GCDaysCount = GCDaysCount + D GCYear = GCYear + 1 Loop 'note The result of the above loop is the total days passed from the Persian origin to the desired date in the function argument 'note In the following lines, the month must be converted to days GCMonth = GCJalaliMonth - 1 If GCMonth <> 0 Then 'note Here, the number of days for the target month in the function argument is calculated, provided it is not 1 (i.e., Farvardin) Select Case GCMonth Case 1 'note If the month is Farvardin, add 31 days to the days 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 'note Add the days of the function argument to the total days GCDaysCount = GCDaysCount + GCJalaliDay 'note Convert the entered Persian date to Gregorian by adding the calculated days to the Gregorian origin GCcalculateDate = DateAdd("d", GCDaysCount - 1, #3/21/1921#) If jalaliDateToGregorian = True Then GregorianCalendar = GCcalculateDate 'note Gregorian date as function output Exit Function End If 'note Convert today's Gregorian date to Persian to determine if the input date of the function is not after today's date GCJalaliNow = JalaliCalendar(Now, jcSplitArray) arrGCJalaliNow = Split(GCJalaliNow, "!") GCDayNow = arrGCJalaliNow(0) GCMonthNow = arrGCJalaliNow(1) GCYearNow = arrGCJalaliNow(2) 'note Compare today's date and the function's input date and determine the correct user input '---------------------------------------------------------------------------- If GCYearNow < GCJalaliYear Then MsgBox "Future date cannot be entered", vbCritical GregorianCalendar = "False" Exit Function End If If GCYearNow = GCJalaliYear Then If GCMonthNow < GCJalaliMonth Then MsgBox "Future date cannot be entered", vbCritical GregorianCalendar = "False" Exit Function End If End If If GCYearNow = GCJalaliYear Then If GCMonthNow = GCJalaliMonth Then If GCDayNow < GCJalaliDay Then MsgBox "Future date cannot be entered", vbCritical GregorianCalendar = "False" Exit Function End If End If End If 'note End of comparison '---------------------------------------------------------------------------- 'note Assign value to the function 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 

Tutorial Video on How to Transfer and Use the Module Functions for Converting Persian to Gregorian Dates in Excel

Summary

This module provides a complete tool for working with Persian and Gregorian dates in the VBA environment. Using this code, you can:

• Convert Gregorian dates to Persian
• Convert Persian dates to Gregorian
• Detect Persian leap years
• Calculate the difference between two Persian dates
• Validate Persian dates

This module can be used in various projects such as accounting systems, management programs, and any application that requires working with Persian dates.