This code accepts a number in digits and returns the amount in words. Both arabic and english funct

by Jad Saleh (1 Submission)
Category: Miscellaneous
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Wed 17^th June 2009
Date Added: Mon 8^th 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
Rate This code accepts a number in digits and returns the amount in words. Both arabic and english funct


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 ' " &#1585;&#1610;&#1575;&#1604;"
   If Len(Dstr) > 0 Then
       If Len(Dstr) > 2 Then Dstr = Left(Dstr, 2)
             If CInt(Dstr) <> 0 Then
                   'If StrWord <> "" Then StrWord = StrWord & " &#1608;"
                   'Call GetDecimal
                   'StrWord = StrWord & BothStr '" &#1601;&#1604;&#1587; "
             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 = " &#1608;" & 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)) & " &#1608;" & Ar(3, CInt(Tstr))
                                           Exit Sub
                                     End If
                               End If
                        End If
                    End If
            End If
        Else
            If Len(BothNum) = 1 Then
                    BothStr = " &#1608;" & Ar(1, CInt(Astr))
                    Exit Sub
            Else
                    If Len(BothNum) = 2 And CInt(Astr) = 0 Then
                        BothStr = " &#1608;" & Ar(3, CInt(Tstr))
                        Exit Sub
                    Else
                       If Len(BothNum) = 2 And CInt(Tstr) = 1 And CInt(Astr) <> 0 Then
                            BothStr = " &#1608;" & Ar(2, CInt(Astr)) ' correct for and
                            Exit Sub
                        Else
                              If Len(BothNum) = 0 Then '111
                                    BothStr = ""
                                    Exit Sub
                              Else
                                     BothStr = " &#1608;" & Ar(1, CInt(Astr)) & " &#1608;" & 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 = " &#1608;" & Ar(1, CInt(Astr))
               Exit Sub
           Else
                 If Len(BothNum) = 1 And CInt(Astr) >= 1 And Len(StrWord) <> 0 Then
                    BothStr = " &#1608;" & 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 = " &#1608;" & 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 = " &#1608;" & Ar(2, CInt(Astr))
                                                Exit Sub
                                         Else
                                                If Len(BothNum) = 2 And Len(StrWord) <> 0 Then
                                                     BothStr = " &#1608;" & Ar(1, CInt(Astr)) & " &#1608;" & 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)) & " &#1608;" & 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 = " &#1608;" & Ar(1, CInt(Astr))
                    Exit Sub
            Else
                    If Len(BothNum) = 2 And CInt(Astr) = 0 Then
                        BothStr = " &#1608;" & Ar(3, CInt(Tstr))
                        Exit Sub
                    Else
                        If Len(BothNum) = 2 And CInt(Tstr) = 1 And CInt(Astr) <> 0 Then
                            BothStr = " &#1608;" & Ar(2, CInt(Astr))
                            Exit Sub
                        Else
                              If Len(BothNum) = 0 Then
                                    BothStr = ""
                                    Exit Sub
                              Else
                                     BothStr = " &#1608;" & Ar(1, CInt(Astr)) & " &#1608;" & 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) = "&#1608;&#1575;&#1581;&#1583;"
Ar(1, 2) = "&#1575;&#1579;&#1606;&#1575;&#1606;"
Ar(1, 3) = "&#1579;&#1604;&#1575;&#1579;&#1577;"
Ar(1, 4) = "&#1571;&#1585;&#1576;&#1593;&#1577;"
Ar(1, 5) = "&#1582;&#1605;&#1587;&#1577;"
Ar(1, 6) = "&#1587;&#1578;&#1577;"
Ar(1, 7) = "&#1587;&#1576;&#1593;&#1577;"
Ar(1, 8) = "&#1579;&#1605;&#1575;&#1606;&#1610;&#1577;"
Ar(1, 9) = "&#1578;&#1587;&#1593;&#1577;"

Ar(2, 1) = "&#1571;&#1581;&#1583; &#1593;&#1588;&#1585;"
Ar(2, 2) = "&#1575;&#1579;&#1606;&#1575; &#1593;&#1588;&#1585;"
Ar(2, 3) = "&#1579;&#1604;&#1575;&#1579;&#1577; &#1593;&#1588;&#1585;"
Ar(2, 4) = "&#1571;&#1585;&#1576;&#1593;&#1577; &#1593;&#1588;&#1585;"
Ar(2, 5) = "&#1582;&#1605;&#1587;&#1577; &#1593;&#1588;&#1585;"
Ar(2, 6) = "&#1587;&#1578;&#1577; &#1593;&#1588;&#1585;"
Ar(2, 7) = "&#1587;&#1576;&#1593;&#1577; &#1593;&#1588;&#1585;"
Ar(2, 8) = "&#1579;&#1605;&#1575;&#1606;&#1610;&#1577; &#1593;&#1588;&#1585;"
Ar(2, 9) = "&#1578;&#1587;&#1593;&#1577; &#1593;&#1588;&#1585;"

Ar(3, 1) = "&#1593;&#1588;&#1585;&#1577;"
Ar(3, 2) = "&#1593;&#1588;&#1585;&#1608;&#1606;"
Ar(3, 3) = "&#1579;&#1604;&#1575;&#1579;&#1608;&#1606;"
Ar(3, 4) = "&#1571;&#1585;&#1576;&#1593;&#1608;&#1606;"
Ar(3, 5) = "&#1582;&#1605;&#1587;&#1608;&#1606;"
Ar(3, 6) = "&#1587;&#1578;&#1608;&#1606;"
Ar(3, 7) = "&#1587;&#1576;&#1593;&#1608;&#1606;"
Ar(3, 8) = "&#1579;&#1605;&#1575;&#1606;&#1608;&#1606;"
Ar(3, 9) = "&#1578;&#1587;&#1593;&#1608;&#1606;"

Ar(4, 1) = "&#1605;&#1575;&#1574;&#1577;"
Ar(4, 2) = "&#1605;&#1574;&#1578;&#1575;&#1606;"
Ar(4, 3) = "&#1579;&#1604;&#1575;&#1579;&#1605;&#1575;&#1574;&#1577;"
Ar(4, 4) = "&#1571;&#1585;&#1576;&#1593;&#1605;&#1575;&#1574;&#1577;"
Ar(4, 5) = "&#1582;&#1605;&#1587;&#1605;&#1575;&#1574;&#1577;"
Ar(4, 6) = "&#1587;&#1578;&#1605;&#1575;&#1574;&#1577;"
Ar(4, 7) = "&#1587;&#1576;&#1593;&#1605;&#1575;&#1574;&#1577;"
Ar(4, 8) = "&#1579;&#1605;&#1575;&#1606;&#1605;&#1575;&#1574;&#1577;"
Ar(4, 9) = "&#1578;&#1587;&#1593;&#1605;&#1575;&#1574;&#1577;"


Ar(5, 1) = "&#1571;&#1604;&#1601;&#1575;&#1606; "
Ar(5, 2) = "&#1570;&#1604;&#1575;&#1601; "
Ar(5, 3) = "&#1571;&#1604;&#1601; "



Ar(6, 1) = "&#1605;&#1604;&#1610;&#1608;&#1606;&#1575;&#1606; "
Ar(6, 2) = "&#1605;&#1604;&#1575;&#1610;&#1610;&#1606; "
Ar(6, 3) = "&#1605;&#1604;&#1610;&#1608;&#1606; "


Ar(7, 1) = "&#1605;&#1604;&#1610;&#1575;&#1585;&#1575;&#1606;"
Ar(7, 2) = "&#1605;&#1604;&#1610;&#1575;&#1585;&#1575;&#1578; "
Ar(7, 3) = "&#1605;&#1604;&#1610;&#1575;&#1585;"

Ar(8, 1) = "&#1576;&#1604;&#1610;&#1608;&#1606;&#1575;&#1606;"
Ar(8, 2) = "&#1576;&#1604;&#1610;&#1608;&#1606;&#1575;&#1578;"
Ar(8, 3) = "&#1576;&#1604;&#1610;&#1608;&#1606;"

Ar(9, 1) = "&#1578;&#1585;&#1604;&#1610;&#1608;&#1606;&#1575;&#1606;"
Ar(9, 2) = "&#1578;&#1585;&#1604;&#1610;&#1608;&#1606;&#1575;&#1578;"
Ar(9, 3) = "&#1578;&#1585;&#1604;&#1610;&#1608;&#1606;"


'----------------------
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
Download this snippet Add to My Saved Code
This code accepts a number in digits and returns the amount in words. Both arabic and english funct Comments

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.
This code accepts a number in digits and returns the amount in words. Both arabic and english funct

This code accepts a number in digits and returns the amount in words. Both arabic and english funct Comments

Post your comment

Difficulty
