bousaid

ARABIC Custom Number To Text - VBA

Jan 12th, 2022 (edited)
411
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. 'Usage: =NumberToText(Q7;"دينار جزائري";"سنتيم")
  2. '
  3. Function NumberToText(Number As Double, MainCurrency As String, SubCurrency As String)
  4. Dim Array1(0 To 9) As String
  5. Dim Array2(0 To 9) As String
  6. Dim Array3(0 To 9) As String
  7. Dim MyNumber As String
  8. Dim GetNumber As String
  9. Dim ReadNumber As String
  10. Dim My100 As String
  11. Dim My10 As String
  12. Dim My1 As String
  13. Dim My11 As String
  14. Dim My12 As String
  15. Dim GetText As String
  16. Dim Billion As String
  17. Dim Million As String
  18. Dim Thousand As String
  19. Dim Hundred As String
  20. Dim Fraction As String
  21. Dim MyAnd As String
  22. Dim I As Integer
  23. Dim ReMark As String
  24.  
  25.  
  26. If Number > 999999999999.99 Then Exit Function
  27. If Number < 0 Then
  28. Number = Number * -1
  29. ReMark = "ناقص "
  30. End If
  31.  
  32. If Number = 0 Then
  33. NumberToText = "صفر"
  34. Exit Function
  35. End If
  36.  
  37. MyAnd = " و"
  38. Array1(0) = ""
  39. Array1(1) = "مائة"
  40. Array1(2) = "مائتان"
  41. Array1(3) = "ثلاثمائة"
  42. Array1(4) = "أربعمائة"
  43. Array1(5) = "خمسمائة"
  44. Array1(6) = "ستمائة"
  45. Array1(7) = "سبعمائة"
  46. Array1(8) = "ثمانمائة"
  47. Array1(9) = "تسعمائة"
  48.  
  49. Array2(0) = ""
  50. Array2(1) = " عشر"
  51. Array2(2) = "عشرون"
  52. Array2(3) = "ثلاثون"
  53. Array2(4) = "أربعون"
  54. Array2(5) = "خمسون"
  55. Array2(6) = "ستون"
  56. Array2(7) = "سبعون"
  57. Array2(8) = "ثمانون"
  58. Array2(9) = "تسعون"
  59.  
  60. Array3(0) = ""
  61. Array3(1) = "واحد"
  62. Array3(2) = "اثنان"
  63. Array3(3) = "ثلاثة"
  64. Array3(4) = "أربعة"
  65. Array3(5) = "خمسة"
  66. Array3(6) = "ستة"
  67. Array3(7) = "سبعة"
  68. Array3(8) = "ثمانية"
  69. Array3(9) = "تسعة"
  70.  
  71. GetNumber = Format(Number, "000000000000.00")
  72.  
  73. I = 0
  74. Do While I < 15
  75.  
  76. If I < 12 Then
  77. MyNumber = Mid$(GetNumber, I + 1, 3)
  78. Else
  79. MyNumber = "0" + Mid$(GetNumber, I + 2, 2)
  80. End If
  81.  
  82. If (Mid$(MyNumber, 1, 3)) > 0 Then
  83.  
  84. ReadNumber = Mid$(MyNumber, 1, 1)
  85. My100 = Array1(ReadNumber)
  86. ReadNumber = Mid$(MyNumber, 3, 1)
  87. My1 = Array3(ReadNumber)
  88. ReadNumber = Mid$(MyNumber, 2, 1)
  89. My10 = Array2(ReadNumber)
  90.  
  91. If Mid$(MyNumber, 2, 2) = 11 Then My11 = "إحدى عشرة"
  92. If Mid$(MyNumber, 2, 2) = 12 Then My12 = "إثنى عشرة"
  93. If Mid$(MyNumber, 2, 2) = 10 Then My10 = "عشرة"
  94.  
  95. If ((Mid$(MyNumber, 1, 1)) > 0) And ((Mid$(MyNumber, 2, 2)) > 0) Then My100 = My100 + MyAnd
  96. If ((Mid$(MyNumber, 3, 1)) > 0) And ((Mid$(MyNumber, 2, 1)) > 1) Then My1 = My1 + MyAnd
  97.  
  98. GetText = My100 + My1 + My10
  99.  
  100. If ((Mid$(MyNumber, 3, 1)) = 1) And ((Mid$(MyNumber, 2, 1)) = 1) Then
  101. GetText = My100 + My11
  102. If ((Mid$(MyNumber, 1, 1)) = 0) Then GetText = My11
  103. End If
  104.  
  105. If ((Mid$(MyNumber, 3, 1)) = 2) And ((Mid$(MyNumber, 2, 1)) = 1) Then
  106. GetText = My100 + My12
  107. If ((Mid$(MyNumber, 1, 1)) = 0) Then GetText = My12
  108. End If
  109.  
  110. If (I = 0) And (GetText <> "") Then
  111. If ((Mid$(MyNumber, 1, 3)) > 10) Then
  112. Billion = GetText + " مليار"
  113. Else
  114. Billion = GetText + " مليارات"
  115. If ((Mid$(MyNumber, 1, 3)) = 2) Then Billion = " مليار"
  116. If ((Mid$(MyNumber, 1, 3)) = 2) Then Billion = " مليارن"
  117. End If
  118. End If
  119.  
  120. If (I = 3) And (GetText <> "") Then
  121.  
  122. If ((Mid$(MyNumber, 1, 3)) > 10) Then
  123. Million = GetText + " مليون"
  124. Else
  125. Million = GetText + " ملايين"
  126. If ((Mid$(MyNumber, 1, 3)) = 1) Then Million = " مليون"
  127. If ((Mid$(MyNumber, 1, 3)) = 2) Then Million = " مليونان"
  128. End If
  129. End If
  130.  
  131. If (I = 6) And (GetText <> "") Then
  132. If ((Mid$(MyNumber, 1, 3)) > 10) Then
  133. Thousand = GetText + " ألف"
  134. Else
  135. Thousand = GetText + " ألاف"
  136. If ((Mid$(MyNumber, 3, 1)) = 1) Then Thousand = " ألف"
  137. If ((Mid$(MyNumber, 3, 1)) = 2) Then Thousand = " ألفان"
  138. End If
  139. End If
  140.  
  141. If (I = 9) And (GetText <> "") Then Hundred = GetText
  142. If (I = 12) And (GetText <> "") Then Fraction = GetText
  143. End If
  144.  
  145. I = I + 3
  146. Loop
  147.  
  148. If (Billion <> "") Then
  149. If (Million <> "") Or (Thousand <> "") Or (Hundred <> "") Then Billion = Billion + MyAnd
  150. End If
  151.  
  152. If (Million <> "") Then
  153. If (Thousand <> "") Or (Hundred <> "") Then Million = Million + MyAnd
  154. End If
  155.  
  156. If (Thousand <> "") Then
  157. If (Hundred <> "") Then Thousand = Thousand + MyAnd
  158. End If
  159.  
  160. If Fraction <> "" Then
  161. If (Billion <> "") Or (Million <> "") Or (Thousand <> "") Or (Hundred <> "") Then
  162. NumberToText = ReMark + Billion + Million + Thousand + Hundred + " " + MainCurrency + MyAnd + Fraction + " " + SubCurrency
  163. Else
  164. NumberToText = ReMark + Fraction + " " + SubCurrency
  165. End If
  166. Else
  167. NumberToText = ReMark + Billion + Million + Thousand + Hundred + " " + MainCurrency
  168. End If
  169. End Function
Add Comment
Please, Sign In to add comment