مشکل با ذخیره تاریخ فارسی

[arenaw]

سلام
میخواستم بدونم راهی هست که بشه از نوع Date برای تاریخ های فارسی استفاده کرد؟
مثلا شما وقتی میخوای تاریخ 31 اردیبهشت رو بدی به این نوع، ویژوال بیسیک ارور Type mismatch
(چون ماه دوم میلادی معمولا 28 یا 29 روز دارد)
>

Dim Emrooz As Date
Emrooz = "31,2,1391"


اگرم بشه یه نوع خودمون تعریف کنیم هم خوب میشه ولی میخوام مثل همین نوع کار کنه، یعنی مثلا با Day(emrooz) روز این تاریخ رو برگردونه و ...

[محسن واژدی]

سلام علیکم
از آنجایی که نمیتوان از نوع داده Date برای تاریخ شمسی استفاده کرد، میتوانیم توابع Day,Month و Year را بجای نوع داده Date سفارشی کنیم، برای اینکار کد زیر را در مادول کد کپی کنید و مانند دفعات قبل دوباره از تابع Day استفاده کنید:

Public Function Day(ByVal vDate, Optional ByVal sDelimiter$ = ",")
vDate = Trim(vDate)
Day = Split(vDate, sDelimiter$)(0)
If Not Len(Day) = 2 And Not Len(Day) = 1 Then Day = Split(vDate, sDelimiter$)(2)
If Not Len(Day) = 2 And Not Len(Day) = 1 Then Day = "": Err.Raise 13, , Error(13)
End Function

Public Function Month(ByVal vDate, Optional ByVal sDelimiter$ = ",")
vDate = Trim(vDate)
Month = Split(vDate, sDelimiter$)(1)
End Function

Public Function Year(ByVal vDate, Optional ByVal sDelimiter$ = ",")
vDate = Trim(vDate)
Year = Split(vDate, sDelimiter$)(2)
If Not Len(Year) = 4 Then Year = Split(vDate, sDelimiter$)(0)
If Not Len(Year) = 4 Then Year = "": Err.Raise 13, , Error(13)
End Function


در اینصورت کد را میتوانیم بصورت زیر تغییر دهیم:

Dim Emrooz As String
Emrooz = "31,2,1391"

Msgbox Day(emrooz)


موفق باشید

[arenaw]

خیلی ممنون جناب واژدی ولی خب اینجوری هرچیزی رو بدون مشکل میتونیم توی اون استرینگ تاریخ بریزیم (مثلا 123132,123123,3434)
من میخواستم یه نوع تاریخ استاندارد باشه ولی مثلا با 31/2 مشکل نداشته باشه

[M.T.P]

یه تابع به همین منظور قبلا نوشته بودم که اینجا میزارم امیدوارم کارتون راه بیفته.

تابع تشخیص تاریخ شمسی: (با الگوریتم شناسایی سال کبیسه)


Public Function IsPersianDate(ByVal sDate As String, _
ByVal sDelimiter As String) As Boolean

Dim blnReturn As Boolean
Dim intRuzeMah As Integer
Dim intRuz As Integer
Dim intSal As Integer
Dim intMah As Integer
Dim arrData() As String

blnReturn = False

sDate = Trim$(sDate)
sDelimiter = Trim$(sDelimiter)

If sDate = vbNullString Then GoTo EndLine
If sDelimiter = vbNullString Then GoTo EndLine

arrData = Split(sDate, sDelimiter)

If UBound(arrData) <> 2 Then GoTo EndLine

intSal = Val(arrData(0))
intMah = Val(arrData(1))
intRuz = Val(arrData(2))

If intSal < 0 Or intSal > 9999 Then GoTo EndLine
If intMah < 1 Or intMah > 12 Then GoTo EndLine
If intRuz < 1 Or intRuz > 31 Then GoTo EndLine

intRuzeMah = Choose(intMah, 31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 29)

If intMah = 12 And (intSal Mod 4) = 3 Then
intRuzeMah = 30
End If

If intRuz < intRuzeMah Or intRuz > intRuzeMah Then GoTo EndLine

blnReturn = True

EndLine:
IsPersianDate = blnReturn
End Function


مثال برای استفاده:

MsgBox IsPersianDate("1390/12/30", "/")

[arenaw]

جناب M.T.P ممنونم ولی سال کبیسه فارسی کمی محاسبش سختره از if sal mod 4 = 3 ....
البته مشکلم با همون ذخیره توی string به جای date حل شد

[just4froum]

البته من کد جناب M.T.P رو ندیدم ولی این یه تابع که تاریخ میلادی رو تبدیل میکنه به شمسی :
Private Function FarsiDate(TarikhMiladi As String) As String
Dim DayNumber As Integer
Dim Kabiseh As Byte
Dim S As String
Dim Day, Month, Year As Integer
Dim FarsiMonth As String
If TarikhMiladi = "" Then
TarikhMiladi = Format(Date$, "dd/MM/yyyy")
Else
TarikhMiladi = Format(TarikhMiladi, "dd/MM/yyyy")
End If
Day = Val(Left$(TarikhMiladi, 2))
Month = Val(Mid$(TarikhMiladi, 4, 2))
Year = Val(Mid$(TarikhMiladi, 7))
DayNumber = (Format(Date, "yyyy") - 622 Mod 1000) Mod 100
If (((Year Mod 1000) Mod 100) = DayNumber) Or _
(((Year Mod 1000) Mod 100) = DayNumber + 1) Then
Year = 1300 + ((Year Mod 1000) Mod 100)
FarsiDate = LTrim$(Str$(Year)) + "/" + LTrim$(Str$(Month)) + "/" + LTrim$(Str$(Day))
Exit Function
End If
If Year Mod 4 = 0 Then Kabiseh = 1 Else Kabiseh = 0
Select Case Month
Case 1: DayNumber = Day
Case 2: DayNumber = 31 + Day
Case 3: DayNumber = 31 + 28 + Kabiseh + Day
Case 4: DayNumber = 31 + 28 + Kabiseh + 31 + Day
Case 5: DayNumber = 31 + 28 + Kabiseh + 31 + 30 + Day
Case 6: DayNumber = 31 + 28 + Kabiseh + 31 + 30 + 31 + Day
Case 7: DayNumber = 31 + 28 + Kabiseh + 31 + 30 + 31 + 30 + Day
Case 8: DayNumber = 31 + 28 + Kabiseh + 31 + 30 + 31 + 30 + 31 + Day
Case 9: DayNumber = 31 + 28 + Kabiseh + 31 + 30 + 31 + 30 + 31 + 31 + Day
Case 10: DayNumber = 31 + 28 + Kabiseh + 31 + 30 + 31 + 30 + 31 + 31 + 30 + Day
Case 11: DayNumber = 31 + 28 + Kabiseh + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31 + Day
Case 12: DayNumber = 31 + 28 + Kabiseh + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31 + 30 + Day
End Select
Year = Year - 622
Month = Month + 9
If DayNumber > 79 Then
DayNumber = DayNumber - (79 - Kabiseh)
Year = Year + 1
Else
DayNumber = DayNumber + (286 + Kabiseh)
End If
If Month > 12 Then Month = Month - 11
If DayNumber <= 186 Then
Month = (DayNumber \ 31) + 1
If (DayNumber Mod 31) = 0 Then Month = Month - 1
Day = (DayNumber Mod 31)
If Day = 0 Then Day = 31
Else
Month = 7 + ((DayNumber - 186) \ 30)
If Month > 12 Then Month = 12
If ((DayNumber - 186) Mod 30) = 0 Then Month = Month - 1
Day = (DayNumber - 186) Mod 30
If Day = 0 Then Day = 30
End If
FarsiMonth = LTrim$(CByte(Month))
FarsiDate = LTrim$(Str$(Year)) + "/" + FarsiMonth + "/" + LTrim$(Str$(Day))
End Function