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

Private Const hezar = " هزار"
Private Const melun = " میلیون "
Private Const melyard = " میلیارد "
Private Const va = " و "

Public Function Adad(ByVal Adad_En 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_En As String
Dim LENAdad_En As Integer
hooroof = ""
STRAdad_En = Str(Val(Str(Adad_En)))
LENAdad_En = Len(STRAdad_En)

Select Case Adad_En
Case Is = 0
hooroof = "صفر"
Case 1 To 999
hooroof = Adad_En_Heji(Adad_En)

Case 1000 To 999999

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

Case 1000000 To 999999999

SS = Val(Right$(STRAdad_En, 3))
hh = Val(Mid$(STRAdad_En, LENAdad_En - 5, 3))
mm = Val(Left$(STRAdad_En, LENAdad_En - 6))

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

Case 1000000000 To 999999999999.0#

SS = Val(Right$(STRAdad_En, 3))
hh = Val(Mid$(STRAdad_En, LENAdad_En - 5, 3))
mm = Val(Mid$(STRAdad_En, LENAdad_En - 8, 3))
yy = Val(Left$(STRAdad_En, LENAdad_En - 9))

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

Case Is > 999999999999.0#
hooroof = "عدد وارد شده خارج از محدوده می باشد "

End Select

Adad = hooroof
End Function

Private Function Adad_En_Heji(ByVal Adad_En 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_En Mod 10
dahgan = Adad_En Mod 100
sadgan = Int(Adad_En / 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_En 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_En_Heji = behooroof
End Function

موفق باشید .