by Jad Saleh (1 Submission)
Category: Miscellaneous
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Wed 17th June 2009
Date Added: Mon 8th February 2021
Rating: (1 Votes)
This code accepts a number in digits and returns the amount in words. Both arabic and english functions are available.
API Declarations
Dim NumNwords As String
Dim Ar(11, 11) As String
Dim TempAr(6, 6) As Integer
Dim TmpC As Integer ' for test
Dim Counter, TempCounter, DesCounter, DesTempCounter, tT As Integer
Dim Hstr, Tstr, Astr, BothStr, Fstr, BothNum, StrWord, Dstr As String
Dim StrNum, Tempstr As String
Dim TempNum, Strlen, i, j As Integer
Dim Arr(3, 10) As String
Dim Temp, Cents, Htxt As String
Dim Hnum, Tnum As Integer
Call A_Initialize
TmpC = 0
tT = 0
NumNwords = ""
'MsgBox Format(TxtNum.Text, "###,###,###,###,###,###.00") & Chr(10) & Chr(13) & Len(TxtNum.Text)
'TxtNum.Text = TmpC
'Randomize
'TxtNum.Text = Int(20 * Rnd) * Int(165 * Rnd)
'NumInput
If Not IsNumeric(Amount) Then
MsgBox "The amount Must be in this format" & Chr(10) & Chr(13) & "#####.##", , "FYI"
Exit Function
End If
For i = 1 To 6
For j = 1 To 6
TempAr(i, j) = 0
Next j
Next i
Counter = 1
StrWord = ""
Dstr = ""
StrNum = Format(Amount, "##################.00") 'TxtNum.Text ' getting the number
i = InStr(1, StrNum, ".")
If i <> 0 Then
Dstr = Right(StrNum, Len(StrNum) - i)
'If Len(Dstr) <> 0 Then
StrNum = Left(StrNum, i - 1)
'End If
End If
If Len(StrNum) > 18 Then
MsgBox " The amount must not exceed this amount :" & Chr(10) & Chr(13) & "999,999,999,999,999,999.99", , "FYI"
Exit Function
End If
'Strnum = Format(Strnum, "###############.##")
'MsgBox Strnum
'Exit Sub
Tempstr = StrNum
Strlen = Len(Tempstr)
Do While (Strlen >= 3)
TempAr(Counter, 1) = Mid(Tempstr, Strlen - 2, 1) 'Strlen - 2)
TempAr(Counter, 2) = Mid(Tempstr, Strlen - 1, 1) 'Strlen - 1)
TempAr(Counter, 3) = Mid(Tempstr, Strlen, 1)
TempAr(Counter, 4) = 3
'MsgBox TempAr(Counter, 1) & TempAr(Counter, 2) & TempAr(Counter, 3)
Tempstr = Left(Tempstr, Len(Tempstr) - 3)
Strlen = Len(Tempstr)
Counter = Counter + 1
Loop
If Strlen = 0 Then
Counter = Counter - 1
Else
Tempstr = StrReverse(Tempstr)
TempAr(Counter, 4) = CStr(Strlen)
End If
For i = 1 To Strlen
TempAr(Counter, 4 - i) = Mid(Tempstr, i, 1)
Next i
TempCounter = Counter
Do While (Counter > 0)
Call GetDataH
StrWord = StrWord & Hstr
Call GetDataR
StrWord = StrWord & BothStr
Call Faction
If Counter > 1 Then
StrWord = StrWord & Fstr
End If
Counter = Counter - 1
Loop
'MsgBox Tstr & Astr
If Len(StrWord) > 0 Then StrWord = StrWord ' " ريال"
If Len(Dstr) > 0 Then
If Len(Dstr) > 2 Then Dstr = Left(Dstr, 2)
If CInt(Dstr) <> 0 Then
'If StrWord <> "" Then StrWord = StrWord & " و"
'Call GetDecimal
'StrWord = StrWord & BothStr '" فلس "
End If
'End If
'TxtNum.Text = Format(TxtNum.Text, "###,###,###,###,###,###.00")
End If
'TxtWord.Text = Strword
NumNwords = StrWord
StrWord = ""
Hstr = ""
Astr = ""
BothStr = ""
Tstr = ""
Dstr = ""
Arb = NumNwords
End Function
Public Function Eng(Amount As String) As String
Call A_Initialize
StrWord = ""
StrNum = Format(Amount, "000000000000.00")
If Not IsNumeric(StrNum) Then
MsgBox "The amount Must be in this format" & Chr(10) & Chr(13) & "#####.##", , "FYI"
Exit Function
End If
Cents = Mid(StrNum, Len(StrNum) - 1, 2)
StrNum = Mid(StrNum, 1, Len(StrNum) - 3)
For i = 4 To 1 Step -1
Hnum = CInt(Mid(StrNum, 1, 1))
Htxt = Mid(StrNum, 2, 2)
Tnum = CInt(Mid(StrNum, 2, 2))
StrNum = Mid(StrNum, 4, Len(StrNum))
StrWord = StrWord & Arr(1, Hnum)
If Hnum <> 0 Then StrWord = StrWord & "Hundrad "
If Tnum >= 10 And Tnum <= 19 Then
StrWord = StrWord & Arr(2, Tnum - 10)
Else
StrWord = StrWord & Arr(3, Mid(Htxt, 1, 1))
StrWord = StrWord & Arr(1, Mid(Htxt, 2, 1))
End If
If CInt(CStr(Hnum) & CStr(Tnum)) <> 0 Then
Select Case i
Case 4
StrWord = StrWord & "Bilion "
Case 3
StrWord = StrWord & "Million "
Case 2
StrWord = StrWord & "Thousand "
End Select
End If
Next i
'StrWord = StrWord & "DollArrs "
If CInt(Cents) <> 0 Then
If CInt(Cents) >= 10 And CInt(Cents) <= 19 Then
StrWord = StrWord & Arr(2, CInt(Cents) - 10)
Else
StrWord = StrWord & Arr(3, Mid(Cents, 1, 1))
StrWord = StrWord & Arr(1, Mid(Cents, 2, 1))
End If
StrWord = StrWord '& "Cents"
End If
Eng = StrWord
End Function
Private Sub GetDataH()
Hstr = ""
If TempAr(Counter, 1) = 0 Then Exit Sub
If TempCounter = Counter Then
Hstr = Ar(4, TempAr(Counter, 1))
Exit Sub
End If
If Len(StrWord) = 0 Then
Hstr = Ar(4, TempAr(Counter, 1))
Exit Sub
End If
If TempCounter > Counter And TempAr(Counter, 1) <> 0 Then
Hstr = " و" & Ar(4, TempAr(Counter, 1))
End If
End Sub
Private Sub GetDataR()
Dim j As Integer
Dim s As String
Dim i As Integer
BothStr = ""
'------------------------------------------------
'------------------------------------------------
Hstr = TempAr(Counter, 1)
Tstr = TempAr(Counter, 2)
Astr = TempAr(Counter, 3)
BothNum = CStr(CInt(Tstr & Astr))
If CInt(Hstr & Tstr & Astr) = 0 Then
BothStr = ""
Exit Sub
End If
If CInt(BothNum) = 0 Then BothNum = ""
'MsgBox BothNum
'---------------------------------
i = CInt(Hstr & Tstr & Astr)
'-----------------------------------
If TempCounter = Counter Then
If CInt(Hstr) = 0 Then
If Len(BothNum) = 1 And Counter = 1 Then 'changed
BothStr = Ar(1, CInt(Astr))
Exit Sub
Else
If Len(BothNum) = 2 And CInt(Astr) = 0 Then
BothStr = Ar(3, CInt(Tstr))
Exit Sub
Else
If Len(BothNum) = 2 And CInt(Tstr) = 1 And CInt(Astr) <> 0 Then
BothStr = Ar(2, CInt(Astr))
Exit Sub
Else '----------
If Len(BothNum) = 1 And Counter <> 1 And CInt(Astr) < 3 Then
Exit Sub ' for thousand and above
Else
If Len(BothNum) = 1 And Counter <> 1 And CInt(Astr) <= 9 Then
BothStr = Ar(1, CInt(Astr))
Exit Sub
Else
BothStr = Ar(1, CInt(Astr)) & " و" & Ar(3, CInt(Tstr))
Exit Sub
End If
End If
End If
End If
End If
Else
If Len(BothNum) = 1 Then
BothStr = " و" & Ar(1, CInt(Astr))
Exit Sub
Else
If Len(BothNum) = 2 And CInt(Astr) = 0 Then
BothStr = " و" & Ar(3, CInt(Tstr))
Exit Sub
Else
If Len(BothNum) = 2 And CInt(Tstr) = 1 And CInt(Astr) <> 0 Then
BothStr = " و" & Ar(2, CInt(Astr)) ' correct for and
Exit Sub
Else
If Len(BothNum) = 0 Then '111
BothStr = ""
Exit Sub
Else
BothStr = " و" & Ar(1, CInt(Astr)) & " و" & Ar(3, CInt(Tstr))
Exit Sub
End If '1111
End If '222
End If
End If
End If
Else '-------
If CInt(Hstr) = 0 Then
If Len(BothNum) = 1 And CInt(Astr) > 2 And Len(StrWord) <> 0 Then
BothStr = " و" & Ar(1, CInt(Astr))
Exit Sub
Else
If Len(BothNum) = 1 And CInt(Astr) >= 1 And Len(StrWord) <> 0 Then
BothStr = " و" & Ar(Counter, CInt(Astr))
Exit Sub
Else
If Len(BothNum) = 1 And CInt(Astr) > 2 Then
BothStr = Ar(1, CInt(Astr))
Exit Sub
Else 'added
If Len(BothNum) = 1 And CInt(Astr) >= 1 Then
'BothStr = ""
Exit Sub
Else
If Len(BothNum) = 2 And CInt(Astr) = 0 And Len(StrWord) <> 0 Then
BothStr = " و" & Ar(3, CInt(Tstr))
Exit Sub
Else
If Len(BothNum) = 2 And CInt(Tstr) = 1 And CInt(Astr) <> 0 And Len(StrWord) <> 0 Then
BothStr = " و" & Ar(2, CInt(Astr))
Exit Sub
Else
If Len(BothNum) = 2 And Len(StrWord) <> 0 Then
BothStr = " و" & Ar(1, CInt(Astr)) & " و" & Ar(3, CInt(Tstr))
Exit Sub
Else
If Len(BothNum) = 2 And CInt(Astr) = 0 Then
BothStr = Ar(3, CInt(Tstr))
Exit Sub
Else
If Len(BothNum) = 2 And CInt(Tstr) = 1 And CInt(Astr) <> 0 Then
BothStr = Ar(2, CInt(Astr))
Exit Sub
Else
BothStr = Ar(1, CInt(Astr)) & " و" & Ar(3, CInt(Tstr))
Exit Sub
End If
End If
End If
End If
End If
End If
End If
End If
End If
Else 'without if
If Len(BothNum) = 1 Then
BothStr = " و" & Ar(1, CInt(Astr))
Exit Sub
Else
If Len(BothNum) = 2 And CInt(Astr) = 0 Then
BothStr = " و" & Ar(3, CInt(Tstr))
Exit Sub
Else
If Len(BothNum) = 2 And CInt(Tstr) = 1 And CInt(Astr) <> 0 Then
BothStr = " و" & Ar(2, CInt(Astr))
Exit Sub
Else
If Len(BothNum) = 0 Then
BothStr = ""
Exit Sub
Else
BothStr = " و" & Ar(1, CInt(Astr)) & " و" & Ar(3, CInt(Tstr))
Exit Sub
End If
End If
End If
End If
End If
End If
End Sub
Private Sub Faction()
Dim Nu As Integer
If Counter = 1 Then Exit Sub
Fstr = ""
Nu = CInt(TempAr(Counter, 1) & TempAr(Counter, 2) & TempAr(Counter, 3))
If Nu = 0 Then Exit Sub
If Nu > 2 And Nu < 11 Then
Fstr = " " & Ar(Counter + 3, 2)
Exit Sub
End If
If Nu = 2 Then
Fstr = " " & Ar(Counter + 3, 1)
'Fstr = Ar(Counter + 3, 3)
Exit Sub
End If
Fstr = " " & Ar(Counter + 3, 3)
End Sub
'---------------------------------------------------
Private Sub A_Initialize()
Ar(0, 0) = ""
Ar(0, 1) = ""
Ar(0, 2) = ""
Ar(0, 3) = ""
Ar(0, 4) = ""
Ar(0, 5) = ""
Ar(0, 6) = ""
Ar(0, 7) = ""
Ar(0, 8) = ""
Ar(0, 9) = ""
Ar(0, 10) = ""
Ar(1, 1) = "واحد"
Ar(1, 2) = "اثنان"
Ar(1, 3) = "ثلاثة"
Ar(1, 4) = "أربعة"
Ar(1, 5) = "خمسة"
Ar(1, 6) = "ستة"
Ar(1, 7) = "سبعة"
Ar(1, 8) = "ثمانية"
Ar(1, 9) = "تسعة"
Ar(2, 1) = "أحد عشر"
Ar(2, 2) = "اثنا عشر"
Ar(2, 3) = "ثلاثة عشر"
Ar(2, 4) = "أربعة عشر"
Ar(2, 5) = "خمسة عشر"
Ar(2, 6) = "ستة عشر"
Ar(2, 7) = "سبعة عشر"
Ar(2, 8) = "ثمانية عشر"
Ar(2, 9) = "تسعة عشر"
Ar(3, 1) = "عشرة"
Ar(3, 2) = "عشرون"
Ar(3, 3) = "ثلاثون"
Ar(3, 4) = "أربعون"
Ar(3, 5) = "خمسون"
Ar(3, 6) = "ستون"
Ar(3, 7) = "سبعون"
Ar(3, 8) = "ثمانون"
Ar(3, 9) = "تسعون"
Ar(4, 1) = "مائة"
Ar(4, 2) = "مئتان"
Ar(4, 3) = "ثلاثمائة"
Ar(4, 4) = "أربعمائة"
Ar(4, 5) = "خمسمائة"
Ar(4, 6) = "ستمائة"
Ar(4, 7) = "سبعمائة"
Ar(4, 8) = "ثمانمائة"
Ar(4, 9) = "تسعمائة"
Ar(5, 1) = "ألفان "
Ar(5, 2) = "آلاف "
Ar(5, 3) = "ألف "
Ar(6, 1) = "مليونان "
Ar(6, 2) = "ملايين "
Ar(6, 3) = "مليون "
Ar(7, 1) = "ملياران"
Ar(7, 2) = "مليارات "
Ar(7, 3) = "مليار"
Ar(8, 1) = "بليونان"
Ar(8, 2) = "بليونات"
Ar(8, 3) = "بليون"
Ar(9, 1) = "ترليونان"
Ar(9, 2) = "ترليونات"
Ar(9, 3) = "ترليون"
'----------------------
Arr(1, 0) = ""
Arr(1, 1) = "One "
Arr(1, 2) = "Two "
Arr(1, 3) = "Three "
Arr(1, 4) = "Four "
Arr(1, 5) = "Five "
Arr(1, 6) = "Six "
Arr(1, 7) = "Seven "
Arr(1, 8) = "Eight "
Arr(1, 9) = "Nine "
Arr(2, 0) = "Ten "
Arr(2, 1) = "Eleven "
Arr(2, 2) = "Twelve "
Arr(2, 3) = "Thirteen "
Arr(2, 4) = "Forteen "
Arr(2, 5) = "Fifteen "
Arr(2, 6) = "Sixteen "
Arr(2, 7) = "Seventeen "
Arr(2, 8) = "Eighteen "
Arr(2, 9) = "Ninteen "
Arr(3, 2) = "Twenty "
Arr(3, 3) = "Thirty "
Arr(3, 4) = "Fourty "
Arr(3, 5) = "Fifty "
Arr(3, 6) = "Sixty "
Arr(3, 7) = "Seventy "
Arr(3, 8) = "Eighty "
Arr(3, 9) = "Ninty "
End Sub
No comments have been posted about This code accepts a number in digits and returns the amount in words. Both arabic and english funct. Why not be the first to post a comment about This code accepts a number in digits and returns the amount in words. Both arabic and english funct.