PDA

View Full Version : تاریخ شمسی به حروف



mahtabi
یک شنبه 24 اردیبهشت 1385, 23:57 عصر
با سلام
آیا راهی برای نوشتن تاریخ شمسی به صورت حروف وجود دارد
متشکراز راه نمایی شما

moustafa
دوشنبه 25 اردیبهشت 1385, 08:38 صبح
اقای ازادی یه سری ماجول داره که اعداد را به حرف تبدیل میکنه ویکی هم برای ماه البته با دستور select case خودت میتوانی فانکشن ماه را ایجاد کنی سپس با استفاده از توابع mid انها را کنارهم بذار

mohammadgij
سه شنبه 26 اردیبهشت 1385, 11:14 صبح
اینم یه ماژول فقط برای تاریخ های بدون "/" است. خودتون درستش کنید



Public Function ConvertFarsiDate(SS As String) As String
Dim StrYear$, strMonth$, StrDay$, StrFarsiYear$, i%, FlagOne As Boolean
Dim StrFarsiMonth$, StrFarsiDay$
If Len(SS) = 8 Then
StrYear = Mid(Trim(SS), 1, 4)
strMonth = Mid(Trim(SS), 5, 2)
StrDay = Mid(Trim(SS), 7, 2)

Select Case Mid(StrDay, 1, 1)
Case 0
Select Case Mid(StrDay, 2, 1)
Case 1
StrFarsiDay = StrFarsiDay & "یکم "
Case 2
StrFarsiDay = StrFarsiDay & "دوم "
Case 3
StrFarsiDay = StrFarsiDay & "سوم "
Case 4
StrFarsiDay = StrFarsiDay & "چهارم "
Case 5
StrFarsiDay = StrFarsiDay & "پنجم "
Case 6
StrFarsiDay = StrFarsiDay & "ششم "
Case 7
StrFarsiDay = StrFarsiDay & "هفتم "
Case 8
StrFarsiDay = StrFarsiDay & "هشتم "
Case 9
StrFarsiDay = StrFarsiDay & "نهم "
End Select
Case 1
Select Case Mid(StrDay, 2, 1)
Case 0
StrFarsiDay = StrFarsiDay & "دهم "
Case 1
StrFarsiDay = StrFarsiDay & "یازدهم "
Case 2
StrFarsiDay = StrFarsiDay & "دوازدهم "
Case 3
StrFarsiDay = StrFarsiDay & "سیزدهم "
Case 4
StrFarsiDay = StrFarsiDay & "چهاردهم "
Case 5
StrFarsiDay = StrFarsiDay & "پانزدهم "
Case 6
StrFarsiDay = StrFarsiDay & "شانزدهم "
Case 7
StrFarsiDay = StrFarsiDay & "هفدهم "
Case 8
StrFarsiDay = StrFarsiDay & "هجدهم "
Case 9
StrFarsiDay = StrFarsiDay & "نوزدهم "
End Select
Case 2
Select Case Mid(StrDay, 2, 1)
Case 0
StrFarsiDay = StrFarsiDay & "بیستم "
Case 1
StrFarsiDay = StrFarsiDay & "بیست و یکم "
Case 2
StrFarsiDay = StrFarsiDay & "بیست و دوم "
Case 3
StrFarsiDay = StrFarsiDay & "بیست و سوم "
Case 4
StrFarsiDay = StrFarsiDay & "بیست و چهارم "
Case 5
StrFarsiDay = StrFarsiDay & "بیست و پنجم "
Case 6
StrFarsiDay = StrFarsiDay & "بیست و ششم "
Case 7
StrFarsiDay = StrFarsiDay & "بیست و هفتم "
Case 8
StrFarsiDay = StrFarsiDay & "بیست و هشتم "
Case 9
StrFarsiDay = StrFarsiDay & "بیست و نهم "
End Select
Case 3
Select Case Mid(StrDay, 2, 1)
Case 0
StrFarsiDay = StrFarsiDay & "سی "
Case 1
StrFarsiDay = StrFarsiDay & "سی و یکم "
End Select
End Select

If Mid(strMonth, 1, 1) = 0 Then
Select Case Mid(strMonth, 2, 1)
Case 1
StrFarsiMonth = StrFarsiMonth & "فروردین ماه "
Case 2
StrFarsiMonth = StrFarsiMonth & "اردیبهشت ماه "
Case 3
StrFarsiMonth = StrFarsiMonth & "خرداد ماه "
Case 4
StrFarsiMonth = StrFarsiMonth & "تیر ماه "
Case 5
StrFarsiMonth = StrFarsiMonth & "مرداد ماه "
Case 6
StrFarsiMonth = StrFarsiMonth & "شهریور ماه "
Case 7
StrFarsiMonth = StrFarsiMonth & "مهر ماه "
Case 8
StrFarsiMonth = StrFarsiMonth & "آبان ماه "
Case 9
StrFarsiMonth = StrFarsiMonth & "آذر ماه "
End Select
ElseIf Mid(strMonth, 1, 1) = 1 Then
Select Case Mid(strMonth, 2, 1)
Case 0
StrFarsiMonth = StrFarsiMonth & "دی ماه "
Case 1
StrFarsiMonth = StrFarsiMonth & "بهمن ماه "
Case 2
StrFarsiMonth = StrFarsiMonth & "اسفند ماه "
End Select
End If

For i = 1 To 4
If i = 1 Then
Select Case Mid(StrYear, i, 1)
Case 1
StrFarsiYear = StrFarsiYear & "هزار و "
Case 2
StrFarsiYear = StrFarsiYear & "دو هزار و "
Case 3
StrFarsiYear = StrFarsiYear & "سه هزار و "
Case 4
StrFarsiYear = StrFarsiYear & "چهار هزار و "
Case 5
StrFarsiYear = StrFarsiYear & "پنج هزار و "
Case 6
StrFarsiYear = StrFarsiYear & "شش هزار و "
Case 7
StrFarsiYear = StrFarsiYear & "هفت هزار و "
Case 8
StrFarsiYear = StrFarsiYear & "هشت هزار و "
Case 9
StrFarsiYear = StrFarsiYear & "نه هزار و "
End Select
ElseIf i = 2 Then
Select Case Mid(StrYear, i, 1)
Case 1
StrFarsiYear = StrFarsiYear & "صد و "
Case 2
StrFarsiYear = StrFarsiYear & "دویست و "
Case 3
StrFarsiYear = StrFarsiYear & "سیصد و "
Case 4
StrFarsiYear = StrFarsiYear & "چهار صد و "
Case 5
StrFarsiYear = StrFarsiYear & "پانصد و "
Case 6
StrFarsiYear = StrFarsiYear & "ششصد و "
Case 7
StrFarsiYear = StrFarsiYear & "هفتصد و "
Case 8
StrFarsiYear = StrFarsiYear & "هشتصد و "
Case 9
StrFarsiYear = StrFarsiYear & "نهصد و "
End Select
ElseIf i = 3 Then
Select Case Mid(StrYear, i, 1)
Case 1
'StrFarsiYear = StrFarsiYear & " یک هزار و"
FlagOne = True
Case 2
StrFarsiYear = StrFarsiYear & "بیست و "
Case 3
StrFarsiYear = StrFarsiYear & "سی و "
Case 4
StrFarsiYear = StrFarsiYear & "چهل و "
Case 5
StrFarsiYear = StrFarsiYear & "پنجاه و "
Case 6
StrFarsiYear = StrFarsiYear & "شصت و "
Case 7
StrFarsiYear = StrFarsiYear & "هفتاد و "
Case 8
StrFarsiYear = StrFarsiYear & "هشتاد و "
Case 9
StrFarsiYear = StrFarsiYear & "نود و "
End Select
ElseIf i = 4 Then
If FlagOne = True Then
Select Case Mid(StrYear, i, 1)
Case 1
StrFarsiYear = StrFarsiYear & "یازده و "
Case 2
StrFarsiYear = StrFarsiYear & "دوازده و "
Case 3
StrFarsiYear = StrFarsiYear & "سیزده و "
Case 4
StrFarsiYear = StrFarsiYear & "چهارده و "
Case 5
StrFarsiYear = StrFarsiYear & "پانزده و "
Case 6
StrFarsiYear = StrFarsiYear & "شانزده و "
Case 7
StrFarsiYear = StrFarsiYear & "هفده و "
Case 8
StrFarsiYear = StrFarsiYear & "هجده و "
Case 9
StrFarsiYear = StrFarsiYear & "نوزده و "
End Select
Else
Select Case Mid(StrYear, i, 1)
Case 1
StrFarsiYear = StrFarsiYear & "یک و "
Case 2
StrFarsiYear = StrFarsiYear & "دو و "
Case 3
StrFarsiYear = StrFarsiYear & "سه و "
Case 4
StrFarsiYear = StrFarsiYear & "چهار و "
Case 5
StrFarsiYear = StrFarsiYear & "پنج و "
Case 6
StrFarsiYear = StrFarsiYear & "شش و "
Case 7
StrFarsiYear = StrFarsiYear & "هفت و "
Case 8
StrFarsiYear = StrFarsiYear & "هشت و "
Case 9
StrFarsiYear = StrFarsiYear & "نه و "
End Select
End If
End If

Next i
ConvertFarsiDate = StrFarsiDay & StrFarsiMonth & Mid(StrFarsiYear, 1, Len(StrFarsiYear) - 2)
Else
ConvertFarsiDate = "تاریخ را تصحیح نمایید"
End If
End Function

moustafa
سه شنبه 26 اردیبهشت 1385, 11:29 صبح
اگر از ماجول بالا استفاد کنید
باتابع replace کاراکتر"/" را به "" تبدیل کنید وسپس از ان استفاده نمائید

mahtabi
دوشنبه 01 خرداد 1385, 21:43 عصر
سلام مجدد
از زحمات و صرف وقت شما متشکرم از آن جا که من تازه دارم توابع را یاد می گیرم لطف کنید و در یک مثال عملی آن را برایم شرح دهید

mahtabi
دوشنبه 01 خرداد 1385, 21:54 عصر
منظور از تابع replace را هم نمی دانم ببخشید ولی به طور حیاتی به این کار نیاز دارم

alimaker
دوشنبه 01 خرداد 1385, 21:54 عصر
نمونه کاملی از تقویم فارسی رو با حالت vb براتون آپلود کردم اگه ماژول رو در اکسس کپی کنین و 2 تا تکست باکس ایجاد کنین (که البته خودش داره)میبینین چیه. بازم اگه مشکل داشتین بگین فایل اکسس بذارم.

alimaker
دوشنبه 01 خرداد 1385, 22:01 عصر
اینم از نمونه اکسس.البته من خودم تغییراتی دادم و بهترش کردم که اگه باز مشکلت حل نشد بعدا :لبخند: برات آپلود میکنم.

mahtabi
شنبه 20 خرداد 1385, 22:49 عصر
آقای علی میکر عزیز
با سلام ضمن تشکر از بذل توجه شما منظور نوشتن به صورت بیست و یکم خرداد هزارو سیصد و هشتاد و پنج می باشد تا نتوان با تغییر اعداد در تاریخ گواهی یا چک صادره تغییر و جعل نمود
به هر حال از شما متشکرم و منتظر فایل پیوست جدید هستم

moustafa
یک شنبه 21 خرداد 1385, 00:14 صبح
منظور از تابع replace را هم نمی دانم ببخشید ولی به طور حیاتی به این کار نیاز دارم

Replace(ahmad,"h","w")=awmadبرای حذف/ از 00/00/00

Replace(00/00/00,"","/")

شاپرک
یک شنبه 21 خرداد 1385, 07:04 صبح
به نظر من ماجول آقای آزادی بهتره من همیشه از اون استفاده کردم و هیچ وقت مشکلی نداشتم

alimaker
دوشنبه 22 خرداد 1385, 10:46 صبح
ببخشید که دیر به دیر جواب میدم البته مثل شما
در مورد سوالتون میتونیم تکه کدهایی رو با استفاده از ماژول اصلی اضافه کنیم تا کارمون راه بیفته اگه فرصت کنم حتما این کار رو انجام میدم.:تشویق: