کد HTML:
Function MiladiToShamsi(ByVal StrDate As String) As String
Dim IntArrDay(0 To 1, 1 To 12) As Integer
Dim IntArrRuz(0 To 1, 1 To 12) As Integer
Dim IntI, IntChrisToNoruz As Integer
Dim IntKabiseh, IntLeapYear As Integer
Dim IntYear, IntMonth, IntDay As Integer
Dim IntSal, IntMah, IntRuz As Integer
Dim StrFormat As String
IntArrDay(0, 1) = 31: IntArrDay(0, 2) = 28: IntArrDay(0, 3) = 31: IntArrDay(0, 4) = 30
IntArrDay(0, 5) = 31: IntArrDay(0, 6) = 30: IntArrDay(0, 7) = 31: IntArrDay(0, 8) = 31
IntArrDay(0, 9) = 30: IntArrDay(0, 10) = 31: IntArrDay(0, 11) = 30: IntArrDay(0, 12) = 31
IntArrDay(1, 1) = 31: IntArrDay(1, 2) = 29: IntArrDay(1, 3) = 31: IntArrDay(1, 4) = 30
IntArrDay(1, 5) = 31: IntArrDay(1, 6) = 30: IntArrDay(1, 7) = 31: IntArrDay(1, 8) = 31
IntArrDay(1, 9) = 30: IntArrDay(1, 10) = 31: IntArrDay(1, 11) = 30: IntArrDay(1, 12) = 31
IntArrRuz(0, 1) = 31: IntArrRuz(0, 2) = 31: IntArrRuz(0, 3) = 31: IntArrRuz(0, 4) = 31
IntArrRuz(0, 5) = 31: IntArrRuz(0, 6) = 31: IntArrRuz(0, 7) = 30: IntArrRuz(0, 8) = 30
IntArrRuz(0, 9) = 30: IntArrRuz(0, 10) = 30: IntArrRuz(0, 11) = 30: IntArrRuz(0, 12) = 29
IntArrRuz(1, 1) = 31: IntArrRuz(1, 2) = 31: IntArrRuz(1, 3) = 31: IntArrRuz(1, 4) = 31
IntArrRuz(1, 5) = 31: IntArrRuz(1, 6) = 31: IntArrRuz(1, 7) = 30: IntArrRuz(1, 8) = 30
IntArrRuz(1, 9) = 30: IntArrRuz(1, 10) = 30: IntArrRuz(1, 11) = 30: IntArrRuz(1, 12) = 30
IntYear = Year(StrDate)
IntMonth = Month(StrDate)
IntDay = Day(StrDate)
IntSal = IntYear - 622
If IntYear Mod 4 = 0 Then IntLeapYear = 1 Else IntLeapYear = 0 'Barrasi sale kabisel miladi
If IntSal Mod 4 = 3 Then IntKabiseh = 1 Else IntKabiseh = 0 'Barrasi sale kabisel Shamsi
IntChrisToNoruz = 79
IntRuz = 0
IntRuz = IntRuz + IntDay
For IntI = 1 To IntMonth - 1
IntRuz = IntRuz + IntArrDay(IntLeapYear, IntI)
Next IntI
If (IntRuz > IntChrisToNoruz) Then
IntSal = IntSal + 1
IntRuz = IntRuz - IntChrisToNoruz
Else
For IntMah = 1 To 9
IntRuz = IntRuz + IntArrRuz(IntKabiseh, IntMah)
Next IntMah
If (IntKabiseh = 1) Then
IntRuz = IntRuz + 11
Else
IntRuz = IntRuz + 10
End If
End If
IntMah = 1
While (IntRuz > IntArrRuz(IntKabiseh, IntMah))
IntRuz = IntRuz - IntArrRuz(IntKabiseh, IntMah)
IntMah = IntMah + 1
Wend
StrFormat = CStr(IntSal) & "/" & Format$(IntMah, "00") & "/" & Format$(IntRuz, "00")
MiladiToShamsi = StrFormat
End Function