Function IranDate() As String
    Dim sh_day, sh_month
    Dim ifday, ifmonth, ifyear, ifdayofyear
    Dim iyear, idayofyear
    Dim inumdayofyear
    Dim aifmonthdays
    aifmonthdays = 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
        aifmonthdays(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 > aifmonthdays(ifmonth))
        ifday = ifday - aifmonthdays(ifmonth)
        ifmonth = ifmonth + 1
    Wend
    ifmonth = ifmonth + 1
    sh_year = ifyear
    If ifmonth < 10 And ifday < 10 Then
        IranDate = ifyear & "/0" & ifmonth & "/0" & ifday
        sh_day = "0" & ifday
        sh_month = "0" & ifmonth
    ElseIf ifmonth < 10 Then
        IranDate = ifyear & "/0" & ifmonth & "/" & ifday
        sh_day = ifday
        sh_month = "0" & ifmonth
    ElseIf ifday < 10 Then
        IranDate = ifyear & "/" & ifmonth & "/0" & ifday
        sh_day = "0" & ifday
        sh_month = ifmonth
    Else
        IranDate = ifyear & "/" & ifmonth & "/" & ifday
    End If
End Function

Function isleapyear(nyear)
    isleapyear = (((nyear Mod 4) = 0 And (nyear Mod 100) <> 0) Or (nyear Mod 400) = 0)
End Function

