تاریخ شمسی به حروف

[mahtabi]

با سلام
آیا راهی برای نوشتن تاریخ شمسی به صورت حروف وجود دارد
متشکراز راه نمایی شما

[moustafa]

اقای ازادی یه سری ماجول داره که اعداد را به حرف تبدیل میکنه ویکی هم برای ماه البته با دستور select case خودت میتوانی فانکشن ماه را ایجاد کنی سپس با استفاده از توابع mid انها را کنارهم بذار

[mohammadgij]

اینم یه ماژول فقط برای تاریخ های بدون "/" است. خودتون درستش کنید



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]

اگر از ماجول بالا استفاد کنید
باتابع replace کاراکتر"/" را به "" تبدیل کنید وسپس از ان استفاده نمائید

[mahtabi]

سلام مجدد
از زحمات و صرف وقت شما متشکرم از آن جا که من تازه دارم توابع را یاد می گیرم لطف کنید و در یک مثال عملی آن را برایم شرح دهید

[mahtabi]

منظور از تابع replace را هم نمی دانم ببخشید ولی به طور حیاتی به این کار نیاز دارم

[alimaker]

نمونه کاملی از تقویم فارسی رو با حالت vb براتون آپلود کردم اگه ماژول رو در اکسس کپی کنین و 2 تا تکست باکس ایجاد کنین (که البته خودش داره)میبینین چیه. بازم اگه مشکل داشتین بگین فایل اکسس بذارم.

[alimaker]

اینم از نمونه اکسس.البته من خودم تغییراتی دادم و بهترش کردم که اگه باز مشکلت حل نشد بعدا برات آپلود میکنم.

[mahtabi]

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

[moustafa]

منظور از تابع replace را هم نمی دانم ببخشید ولی به طور حیاتی به این کار نیاز دارم

Replace(ahmad,"h","w")=awmad

برای حذف/ از 00/00/00

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

[شاپرک]

به نظر من ماجول آقای آزادی بهتره من همیشه از اون استفاده کردم و هیچ وقت مشکلی نداشتم

[alimaker]

ببخشید که دیر به دیر جواب میدم البته مثل شما
در مورد سوالتون میتونیم تکه کدهایی رو با استفاده از ماژول اصلی اضافه کنیم تا کارمون راه بیفته اگه فرصت کنم حتما این کار رو انجام میدم.