تبدیل تاریخ میلادی به شمسی و اضافه کردن 3 روز به تاریخ شمسی...

[rezarko]

سلام .
چه جوری میشه تاریخ را به شمسی تبدیل کرد و 3 روز به اون اضافه کرد؟
ممنون

[M.T.P]

تابع تبدیل میلادی به شمسی:



Function MiladiToShamsi(Optional ByVal sDate As String = vbNullString) 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 strReturn 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

If sDate = vbNullString Or IsDate(sDate) = False Then sDate = DateTime.Date$

intYear = Year(sDate)
intMonth = Month(sDate)
intDay = Day(sDate)

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

strReturn = CStr(intSal) & "/" & Format$(intMah, "00") & "/" & Format$(intRuz, "00")
MiladiToShamsi = strReturn
End Function


کد استفاده:


Dim dteDate As Date
dteDate = DateTime.Date$
dteDate = dteDate + 3
Call MsgBox(MiladiToShamsi(dteDate))