[vba-basic] convertir des nombres en lettres (french) V1


/ Published in: Visual Basic
Save to your folder(s)

convert numbers to text (french) V1


Copy this code and paste it in your HTML
  1. ' *****************************************************************************
  2. ' ConvertitLettres
  3. ' *****************************************************************************
  4. Public Function ConvertitLettres(Nombre,ChMonnaie)
  5. Dim NomUnites
  6. Dim valeurs
  7. Dim chaine
  8. dim sVar
  9. 'tableau((billion,milliard,million,millier,unité,décimale),(centaine,dizaine,unité))
  10. Dim strT ' lettres de chaque chiffre selon emplacement
  11. Dim intD ' indicateur si chiffre avant, règle grammaticale (DEUX CENTS, DEUX CENT CINQ)
  12. Dim intT ' chiffre selon emplacement
  13. Dim b ' pour les boucle de traitement
  14. Dim d ' indicateur de décimale
  15. Dim Dizaine
  16. Dim ln
  17. Dim Presence
  18. Dim LeTiret
  19. Dim LaRetenue
  20. Dim Resultat
  21. ReDim NomUnites(90)
  22. ReDim valeurs(5)
  23. ReDim chaine(5)
  24. 'tableau((billion,milliard,million,millier,unité,décimale),(centaine,dizaine,unité))
  25. ReDim strT(5, 2) ' lettres de chaque chiffre selon emplacement
  26. ReDim intD(5, 2) ' indicateur si chiffre avant, règle grammaticale (DEUX CENTS, DEUX CENT CINQ)
  27. ReDim intT(5, 2) ' chiffre selon emplacement
  28. ReDim Presence(5)
  29.  
  30.  
  31. ' Initialisation de valeurs
  32. valeurs(5) = " billion"
  33. valeurs(4) = " milliard"
  34. valeurs(3) = " million"
  35. valeurs(2) = " mille"
  36. valeurs(1) = "" ' unité
  37. valeurs(0) = "" ' décimale
  38.  
  39.  
  40. ' Initialisation des termes de NomUnites
  41. NomUnites(0) = "zéro"
  42. NomUnites(1) = "un"
  43. NomUnites(2) = "deux"
  44. NomUnites(3) = "trois"
  45. NomUnites(4) = "quatre"
  46. NomUnites(5) = "cinq"
  47. NomUnites(6) = "six"
  48. NomUnites(7) = "sept"
  49. NomUnites(8) = "huit"
  50. NomUnites(9) = "neuf"
  51.  
  52.  
  53. ' Initialisation des termes de la dizaine
  54. NomUnites(10) = "dix"
  55. NomUnites(11) = "onze"
  56. NomUnites(12) = "douze"
  57. NomUnites(13) = "treize"
  58. NomUnites(14) = "quatorze"
  59. NomUnites(15) = "quinze"
  60. NomUnites(16) = "seize"
  61. NomUnites(17) = "dix-sept"
  62. NomUnites(18) = "dix-huit"
  63. NomUnites(19) = "dix-neuf"
  64.  
  65.  
  66. ' Initialisation des termes de dizaines
  67. NomUnites(20) = "vingt"
  68. NomUnites(30) = "trente"
  69. NomUnites(40) = "quarante"
  70. NomUnites(50) = "cinquante"
  71. NomUnites(60) = "soixante"
  72. NomUnites(70) = "soixante"
  73. NomUnites(80) = "quatre-vingt"
  74. NomUnites(90) = "quatre-vingt"
  75.  
  76.  
  77. ' Classification du nombre en sous-unités
  78. d = InStr(1, Nombre, ",") ' nombre entier ou avec décimale
  79. If d Then
  80. Nombre = Left(Nombre, d - 1) + "0" + Mid(Nombre, d + 1) ' remplace la virgule par zéro If Len(Nombre) - d 1 Then Nombre Nombre + "0" 's'assure qu'il y a 2 décimales
  81. If Len(Nombre) - d > 2 Then ' sinon on arrondit à 2 décimales
  82. If Mid(Nombre, d + 3, 1) >= 5 Then
  83. Nombre = Mid(Nombre, 1, d + 1) & (1 + Mid(Nombre, d + 2, 1))
  84. Nombre = Mid(Nombre, 1, d + 2)
  85. Else
  86. Nombre = Mid(Nombre, 1, d + 2)
  87. End If
  88. End If
  89. Else
  90. Nombre = Nombre + "000" 'sinon on ajoute pour combler les décimales
  91. End If
  92. intD(0, 0) = 0
  93. ln = Len(Nombre)
  94. For b = 0 To ln - 1
  95. intT(b \ 3, b Mod 3) = Mid(Nombre, ln - b, 1)
  96. If intT(b \ 3, b Mod 3) <> 0 then
  97. sVar = b + 1
  98. else
  99. sVar = intD(b \ 3, b Mod 3)
  100. end if
  101. If (b <> ln - 1) And b > 3 Then intD((b + 1) \ 3, (b + 1) Mod 3) = sVar
  102. Next
  103. ' Recherche des termes adaptés à chaque sous-unité
  104. For b = (ln \ 3 + ln Mod 3) - 1 To 0 Step -1
  105. strT(b, 0) = ""
  106. chaine(b) = ""
  107. LeTiret = False
  108. LaRetenue = 0
  109. If intT(b, 2) * 100 + intT(b, 1) * 10 + intT(b, 0) <> 0 Then
  110. ' Activation du drapeau
  111. Presence(b) = intT(b, 2) * 100 + intT(b, 1) * 10 + intT(b, 0)
  112. ' Nombre supérieur ou égal à 1
  113. ' Vérification si supérieur ou égale à 100
  114. If intT(b, 2) >= 2 Then
  115. if intD(b, 2) <> 0 Then
  116. sVar = ""
  117. else
  118. sVar = "s"
  119. end if
  120. strT(b, 2) = NomUnites(intT(b, 2)) + " cent" + sVar
  121. ElseIf intT(b, 2) = 1 Then
  122. strT(b, 2) = "cent"
  123. End If
  124. Dizaine = intT(b, 1) * 10 + intT(b, 0)
  125. ' Vérification si supérieur à 20
  126. If Dizaine >= 20 Then if intT(b, 1) 8 And intD(b, 1) 0 then
  127. sVar = "s"
  128. else
  129. sVar = ""
  130. end if
  131. strT(b, 1) = NomUnites(intT(b, 1) * 10) + sVar
  132. If Dizaine >= 60 Then
  133. LaRetenue = ((Dizaine \ 10) - 6) Mod 2
  134. End If
  135. LeTiret = True
  136. ElseIf Dizaine >= 10 And Dizaine <= 19 Then
  137. strT(b, 1) = strT(b, 1) + " " + NomUnites(Dizaine)
  138. End If
  139. ' Vérification si unité non-nul
  140. If (intT(b, 0) > 0 And intT(b, 1) <> 1) Or LaRetenue Then 'Dizaine <> 1 Then
  141. If LeTiret And intT(b, 1) <> 1 Then
  142. If intT(b, 0) = 1 And intT(b, 1) < 8 Then
  143. strT(b, 0) = " et " + NomUnites(intT(b, 0) + LaRetenue * 10)
  144. Else
  145. strT(b, 0) = "-" + NomUnites(intT(b, 0) + LaRetenue * 10)
  146. End If
  147. ElseIf b <> 2 Then
  148. strT(b, 0) = NomUnites(intT(b, 0) + LaRetenue * 10)
  149. ElseIf intT(b, 0) <> 1 Then strT(b, 0) = " " + NomUnites(intT(b, 0) + LaRetenue * 10)
  150. End If
  151. End If
  152. ' concatenation des centaines, dizaines et unités et retrait des espaces inutiles
  153. if strT(b, 1) = "" then
  154. sVar = ""
  155. else
  156. sVar = " "
  157. end if
  158. chaine(b) = Trim(Trim(strT(b, 2)) + sVar + Trim(strT(b, 1)))
  159. if Left(strT(b, 0), 1) = "-" then
  160. sVar = ""
  161. else
  162. sVar = " "
  163. end if
  164. chaine(b) = trim(chaine(b) + sVar + Trim(strT(b, 0)))
  165. ' + IIf(Left(strT(b, 0), 1) = "-", "", " ") +
  166. ' ajout de la valeurs si > 1 et différent des Mille (invariable)
  167. if (Presence(b) > 1) And (b > 2) then 'IIf((Presence(b) > 1) And (b > 2), "s", "")
  168. sVar = "s"
  169. else
  170. sVar =""
  171. end if
  172. chaine(b) = chaine(b) + valeurs(b) + sVar
  173. End If
  174. Next
  175.  
  176.  
  177. ' concatenation finale et retrait des espaces inutiles
  178. Resultat = chaine(5)
  179. For b = 4 To 1 Step -1
  180. if chaine(b) <> "" then 'IIf(chaine(b) <> "", " ", "")
  181. sVar = " "
  182. else
  183. sVar = ""
  184. end if
  185. Resultat = Resultat + sVar + chaine(b)
  186. Next If Resultat "" Then Resultat "zéro"
  187. if INSTR(1,Nombre,",")>0 then
  188. if Mid(Nombre, INSTR(1,Nombre,",")+1)*1 > 1 then 'IIf(CDec(Mid(Nombre, 1, Len(Nombre) - 3)) > 1, "s", "")
  189. sVar = "s"
  190. else
  191. sVar = ""
  192. end if
  193. else
  194. sVar = ""
  195. end if If ChMonnaie True Then Resultat Resultat + " Euro" + sVar
  196. If chaine(0) <> "" Then
  197. Resultat = Resultat + " et " + chaine(0)
  198. if Presence(0) > 1 Then 'IIf(Presence(0) > 1, "s", "")
  199. sVar = "s"
  200. else
  201. sVar = ""
  202. end if If ChMonnaie True Then Resultat Resultat + " centime" + sVar
  203. End If
  204. ' Fin
  205. ConvertitLettres = Trim(UCase(Resultat))
  206. End Function

Report this snippet


Comments

RSS Icon Subscribe to comments

You need to login to post a comment.