تبدیل عدد به حروف

[mohajer-n]

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

[شاپرک]

http://try.persianblog.com/

[mohajer-n]

شاپرک جان با تشکر
مشکلم حل شد.

[saras]

سلامدوستان من تازه کارم حالا کجا باید از اون استفاده کنم من یک فرم دارم که در آن جمهع کل کالا را حساب می کند می خواهم که در گزارشم کنار عد مثلا 000/200 ریال معادل آن را به حروف هم بدهد از راهنمایی شما متشکرم.

[mohajer-n]

1-به آدرسی که شاپرک جان داده مراحعه کن و آنرا به عنوان یک ماژول کپی کن
2-در properties سربرگ data در قسمتcontrol source بنویس :
([نام فیلدی که در آن عدد می باشد])adad=

[Mahsa Hatefi]

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

[شاپرک]

Option Explicit
Private Const dahom = "دهم"
Private Const sadom = "صدم"

Private Function Meghdar(Addad)
Dim ziredah(9) As String
Dim dahtabist(19) As String
Dim dahi(9) As String

Dim Dot, Ashar, Yekan, Dahgan

ziredah(1) = "یک": ziredah(2) = "دو": ziredah(3) = "سه": ziredah(4) = "چهار": ziredah(5) = "پنج"
ziredah(6) = "شش": ziredah(7) = "هفت": ziredah(8) = "هشت": ziredah(9) = "نه"

dahtabist(11) = "یازده": dahtabist(12) = "دوازده": dahtabist(13) = "سیزده": dahtabist(14) = "چهارده": dahtabist(15) = "پانزده"
dahtabist(16) = "شانزده": dahtabist(17) = "هفده": dahtabist(18) = "هیجده": dahtabist(19) = "نوزده"

dahi(2) = "بیست": dahi(3) = "سی": dahi(4) = "چهل": dahi(5) = "پنجاه"
dahi(6) = "شصت": dahi(7) = "هفتاد": dahi(8) = "هشتاد": dahi(9) = "نود"

Dot = InStr(1, Addad, ".", vbTextCompare)
If Dot <> 0 Then
Ashar = Mid(Addad, Dot + 1, 2)
Select Case Len(Ashar)
Case Is = 2
If Mid(Ashar, 1, 1) = 0 And Mid(Ashar, 2, 2) <> 0 Then Meghdar = ziredah(Mid(Ashar, 2, 2)) & " " & sadom
If Ashar Mod 10 = 0 And Mid(Ashar, 2, 2) = 0 Then Meghdar = ziredah(Mid(Ashar, 1, 1)) & " " & dahom
If Ashar Mod 10 <> 0 And Mid(Ashar, 1, 1) <> 0 Then Meghdar = dahi(Mid(Ashar, 1, 1)) & " æ " & ziredah(Mid(Ashar, 2, 2)) & " " & sadom
If Mid(Ashar, 1, 1) = 0 And Mid(Ashar, 2, 2) = 0 Then Meghdar = "بدون اعشار"
If Ashar > 10 And Ashar < 20 Then Meghdar = dahtabist(Ashar) & " " & sadom
Case Is = 1
If Mid(Ashar, 1, 1) = 0 Then Meghdar = "بدون اعشار"
If Mid(Ashar, 1, 1) <> 0 Then Meghdar = ziredah(Mid(Ashar, 1, 1)) & " " & dahom
Case Is = 0
Meghdar = "بدون اعشار"
End Select
Else
Meghdar = "بدون اعشار"
End If
End Function

منبع :
http://www.barnamenevis.org/forum/showthread.php?t=15209&page=2
برنامه نویس : مسعود غیبی

[Ali_Fallah]

باسلام
ایا میشه در محیط اکسل نیز همین کار را انجام داد.
ممنون

[Mahsa Hatefi]

Option Explicit
Private Const dahom = "دهم"
Private Const sadom = "صدم"

Private Function Meghdar(Addad)
Dim ziredah(9) As String
Dim dahtabist(19) As String
Dim dahi(9) As String

Dim Dot, Ashar, Yekan, Dahgan

ziredah(1) = "یک": ziredah(2) = "دو": ziredah(3) = "سه": ziredah(4) = "چهار": ziredah(5) = "پنج"
ziredah(6) = "شش": ziredah(7) = "هفت": ziredah(8) = "هشت": ziredah(9) = "نه"

dahtabist(11) = "یازده": dahtabist(12) = "دوازده": dahtabist(13) = "سیزده": dahtabist(14) = "چهارده": dahtabist(15) = "پانزده"
dahtabist(16) = "شانزده": dahtabist(17) = "هفده": dahtabist(18) = "هیجده": dahtabist(19) = "نوزده"

dahi(2) = "بیست": dahi(3) = "سی": dahi(4) = "چهل": dahi(5) = "پنجاه"
dahi(6) = "شصت": dahi(7) = "هفتاد": dahi(8) = "هشتاد": dahi(9) = "نود"

Dot = InStr(1, Addad, ".", vbTextCompare)
If Dot <> 0 Then 'با این ; مشکل دارم
Ashar = Mid(Addad, Dot + 1, 2)
Select Case Len(Ashar)
Case Is = 2
If Mid(Ashar, 1, 1) = 0 And Mid(Ashar, 2, 2) <> 0 Then Meghdar = ziredah(Mid(Ashar, 2, 2)) & " " & sadom
If Ashar Mod 10 = 0 And Mid(Ashar, 2, 2) = 0 Then Meghdar = ziredah(Mid(Ashar, 1, 1)) & " " & dahom
If Ashar Mod 10 <> 0 And Mid(Ashar, 1, 1) <> 0 Then Meghdar = dahi(Mid(Ashar, 1, 1)) & " æ " & ziredah(Mid(Ashar, 2, 2)) & " " & sadom
If Mid(Ashar, 1, 1) = 0 And Mid(Ashar, 2, 2) = 0 Then Meghdar = "بدون اعشار"
If Ashar > 10 And Ashar < 20 Then Meghdar = dahtabist(Ashar) & " " & sadom
Case Is = 1
If Mid(Ashar, 1, 1) = 0 Then Meghdar = "بدون اعشار"
If Mid(Ashar, 1, 1) <> 0 Then Meghdar = ziredah(Mid(Ashar, 1, 1)) & " " & dahom
Case Is = 0
Meghdar = "بدون اعشار"
End Select
Else
Meghdar = "بدون اعشار"
End If
End Function

منبع :
http://www.barnamenevis.org/forum/showthread.php?t=15209&page=2
برنامه نویس : مسعود غیبی

من دوسه تا ماژول داشتم که توی دوتاش همین مشکلو دارم و اون error در قسمت " ; " توی این کد و بقیه کدها هستش . نمی دونم من از این " ; " سمی کالن سر در نمیارم یا اینکه فونت دستگاه من موقع خوندن کاراکتری رو با " ; " عوض می کنه .

[Mahsa Hatefi]

شاپرک جان واقعا مرثی
ولی نمی دونم مشکلم با این " ; " سمی کالن ، توی این کد چیه ؟ عبارت ;lt چیه ؟