مرجع حل مشکلات زبان فارسی و سورسهای مربوطه

[M-Gheibi]

کد زیر برای تبدیل مقدار عددی به حروف است .
به این نکته دقت داشته باشید که حداکثر مقدار قابل قبول برای این تابع 999,999,999,999 ( نهصد و نود و نه میلیارد و نهصد و نود و نه میلیون و نهصد و نود نه هزار و نهصد و نود و نه ) می باشد .
تابع زیر نوشته جناب آقای بابک بخشایش هست .

Option Explicit

Private Const hezar = " هزار"

Private Const melun = " میلیون"

Private Const melyard = " میلیارد"

Private Const va = " و "



Public Function heji_adad(ByVal adad As Double) As String

Dim hooroof As String

Dim SS As Integer  'sadgan

Dim hh As Integer   'hezargan

Dim mm As Integer  'melungan

Dim yy As Integer   'melyardgan

Dim STRadad As String

Dim LENadad As Integer



STRadad = Str(Val(Str(adad)))

LENadad = Len(STRadad)



Select Case adad

    Case Is = 0

        hooroof = "صفر"

    Case 1 To 999

        hooroof = Adad_Heji(adad)

    Case 1000 To 999999

       If (adad Mod 1000 = 0) Then hooroof = Adad_Heji(Int(adad / 1000)) + hezar

       If (adad Mod 1000 <> 0) Then hooroof = Adad_Heji(Int(adad / 1000)) + hezar + va + (Adad_Heji(adad Mod 1000))

    Case 1000000 To 999999999

        SS = Val(Right$(STRadad, 3))

        hh = Val(Mid$(STRadad, LENadad - 5, 3))

        mm = Val(Left$(STRadad, LENadad - 6))

        If (SS = 0 And hh = 0) Then hooroof = Adad_Heji(mm) + melun

        If (SS = 0 And hh <> 0) Then hooroof = Adad_Heji(mm) + melun + va + Adad_Heji(hh) + hezar

        If (SS <> 0 And hh = 0) Then hooroof = Adad_Heji(mm) + melun + va + Adad_Heji(SS)

        If (SS <> 0 And hh <> 0) Then hooroof = Adad_Heji(mm) + melun + va + Adad_Heji(hh) + hezar + va + Adad_Heji(SS)

    Case 1000000000 To 999999999999#

        SS = Val(Right$(STRadad, 3))

        hh = Val(Mid$(STRadad, LENadad - 5, 3))

        mm = Val(Mid$(STRadad, LENadad - 8, 3))

        yy = Val(Left$(STRadad, LENadad - 9))

        If (SS = 0 And hh = 0 And mm = 0) Then hooroof = Adad_Heji(yy) + melyard

        If (SS = 0 And hh = 0 And mm <> 0) Then hooroof = Adad_Heji(yy) + melyard + va + Adad_Heji(mm) + melun

        If (SS = 0 And hh <> 0 And mm <> 0) Then hooroof = Adad_Heji(yy) + melyard + va + Adad_Heji(mm) + melun + va + Adad_Heji(hh) + hezar

        If (SS <> 0 And hh <> 0 And mm <> 0) Then hooroof = Adad_Heji(yy) + melyard + va + Adad_Heji(mm) + melun + va + Adad_Heji(hh) + hezar + va + Adad_Heji(SS)

    Case Is > 999999999999#

        hooroof = "عدد وارد شده بزرگتر از 999999999999 است"

End Select

heji_adad = hooroof

End Function



Private Function Adad_Heji(ByVal adad As Integer) As String

Dim yekan As Byte

Dim dahgan As Byte

Dim sadgan As Byte

Dim behooroof As String

Dim heji(19) As String

Dim heji_dahgan(9) As String

Dim heji_sadgan(9) As String

'-------------------------------

heji(1) = "یک": heji(2) = "دو": heji(3) = "سه": heji(4) = "چهار": heji(5) = "پنج"

heji(6) = "شش": heji(7) = "هفت": heji(8) = "هشت": heji(9) = "نه": heji(10) = "ده"

heji(11) = "یازده": heji(12) = "دوازده": heji(13) = "سیزده": heji(14) = "چهارده": heji(15) = "پانزده"

heji(16) = "شانزده": heji(17) = "هفده": heji(18) = "هیجده": heji(19) = "نوزده"

'-------------------------------

heji_dahgan(1) = "ده"

heji_dahgan(2) = "بیست"

heji_dahgan(3) = "سی": heji_dahgan(4) = "چهل": heji_dahgan(5) = "پنجاه"

heji_dahgan(6) = "شصت": heji_dahgan(7) = "هفتاد": heji_dahgan(8) = "هشتاد"

heji_dahgan(9) = "نود"

'-------------------------------

heji_sadgan(1) = "یکصد": heji_sadgan(2) = "دویست": heji_sadgan(3) = "سیصد"

heji_sadgan(4) = "چهارصد": heji_sadgan(5) = "پانصد": heji_sadgan(6) = "ششصد"

heji_sadgan(7) = "هفتصد": heji_sadgan(8) = "هشتصد": heji_sadgan(9) = "نهصد"

'-------------------------------

yekan = adad Mod 10

dahgan = adad Mod 100

sadgan = Int(adad / 100)

'-------------------------------

If dahgan < 20 Then

    If (sadgan = 0) Then behooroof = heji(dahgan)

    If (sadgan <> 0) Then behooroof = heji_sadgan(sadgan) + va + heji(dahgan)

    If (yekan = 0 And dahgan = 0) Then behooroof = heji_sadgan(sadgan)

Else

    dahgan = (adad Mod 100) - yekan

    If (sadgan = 0 And yekan = 0) Then behooroof = heji_dahgan(dahgan / 10)

    If (sadgan = 0 And yekan <> 0) Then behooroof = heji_dahgan(dahgan / 10) + va + heji(yekan)

    If (sadgan <> 0 And yekan = 0) Then behooroof = heji_sadgan(sadgan) + va + heji_dahgan(dahgan / 10)

    If (sadgan <> 0 And yekan <> 0) Then behooroof = heji_sadgan(sadgan) + va + heji_dahgan(dahgan / 10) + va + heji(yekan)

End If

        

Adad_Heji = behooroof

End Function

طرز استفاده :

Text1.text = heji_adad(156489)

با اجرای کد بالا عبارت "یکصد و پنجاه و شش هزار و چهارصد و هشتاد و نه" در Text1 نمایش داده خواهد شد .