ang Traduire les chiffres en lettres

Éditeur : Mourad CHAIB-CHERIF   +
Mise à jour le : 23/05/2012  ·   Licence : Autre  ·   Téléchargé 393 fois   ·  

CommentairesLa discussion sur le forum
Présentation
Ce script permet de traduire les caractères numériques en lettre.
Téléchargement
Compatibilité
Windows  
  1. Option Explicit
  2.  
  3. Private WithEvents MonClasseur As Excel.Workbook
  4. Private MaFeuille As Excel.Worksheet
  5. Const Sep = ","
  6. Public Nombre, GrosNombre
  7. Dim Dec As Boolean
  8.  
  9.  
  10. Private Sub CommandButton1_Click()
  11.  
  12. 'D?claration des variables
  13. '-----------------------------------
  14. Dim valeur, D?cimal, StrReste, EnTexte As String
  15. Dim Val_Entier, Stade, i, J, Etape As Integer
  16.  
  17.  
  18. Dim Val_Dec(6) As String
  19. Dim Val_Int(6) As String
  20.  
  21. Dim Texte_ As String
  22. Dim Decimal_ As String
  23.  
  24. Nombre = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf", "dix", _
  25. "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix sept", "dix huit", "dix neuf", "vingt", _
  26. "vingt et un", "vingt deux", "vingt trois", "vingt quatre", "vingt cinq", "vingt six", "vingt sept", "vingt huit", "vingt neuf", "trente", _
  27. "trente et un", "trente deux", "trente trois", "trente quatre", "trente cinq", "trente six", "trente sept", "trente huit", "trente neuf", "quarante", _
  28. "quarante et un", "quarante deux", "quarante trois", "quarante quatre", "quarante cinq", "quarante six", "quarante sept", "quarante huit", "quarante neuf", "cinquante", _
  29. "cinquante et un", "cinquante deux", "cinquante trois", "cinquante quatre", "cinquante cinq", "cinquante six", "cinquante sept", "cinquante huit", "cinquante neuf", "soixante", _
  30. "soixante et un", "soixante deux", "soixante trois", "soixante quatre", "soixante cinq", "soixante six", "soixante sept", "soixante huit", "soixante neuf", "soixante dix", _
  31. "soixante et onze", "soixante douze", "soixante treize", "soixante quatorze", "soixante quinze", "soixante seize", "soixante dix sept", "soixante dix huit", "soixante dix neuf", "quatre vingts", _
  32. "quatre vingt un", "quatre vingt deux", "quatre vingt trois", "quatre vingt quatre", "quatre vingt cinq", "quatre vingt six", "quatre vingt sept", "quatre vingt huit", "quatre vingt neuf", "quatre vingt dix", _
  33. "quatre vingt onze", "quatre vingt douze", "quatre vingt treize", "quatre vingt quatorze", "quatre vingt quinze", "quatre vingt seize", "quatre vingt dix sept", "quatre vingt dix huit", "quatre vingt dix neuf")
  34.  
  35. GrosNombre = Array(" ", "mille", "million", "milliard", "billion")
  36.  
  37.  
  38. 'D?claration de la feuille Excel
  39. '----------------------------------
  40. Set MonClasseur = ActiveWorkbook
  41. Set MaFeuille = MonClasseur.Worksheets("Feuil1")
  42.  
  43.  
  44. MaFeuille.Activate
  45. MaFeuille.Range("K7").Select
  46.  
  47.  
  48.  
  49. Do
  50.  
  51. If IsEmpty(ActiveCell) = False Then
  52.  
  53. 'R?cup?rer la valeur de la cellule en cours
  54. '-----------------------------------------------
  55. valeur = ActiveCell.Value
  56.  
  57. Decimal_ = ""
  58. Dec = False
  59.  
  60. 'Extraire les caract?res d?cimaux
  61. '-------------------------------------
  62. D?cimal = Split(CStr(valeur), Sep)
  63. If UBound(D?cimal) <> 0 Then
  64.  
  65. StrReste = D?cimal(1)
  66. Dec = True
  67. If Len(StrReste) = 1 Then StrReste = StrReste * 10
  68.  
  69. StrReste = FormatCaracter(Int(StrReste))
  70. Stade = (Len(StrReste) / 3)
  71.  
  72. J = Stade - 1
  73. Etape = Stade
  74. Decimal_ = ""
  75.  
  76. For i = 0 To Stade - 1
  77. EnTexte = ""
  78. EnTexte = Mid(StrReste, (i * 3) + 1, 3)
  79.  
  80. Select Case Etape
  81. Case 2
  82. If Centaine(EnTexte) = "un" Then
  83. Decimal_ = GrosNombre(J)
  84. ElseIf Centaine(EnTexte) <> "un" Then
  85. If Decimal_ = "" Then
  86. Decimal_ = Centaine(EnTexte) + " " + GrosNombre(J)
  87. ElseIf Decimal_ <> "" Then
  88. Decimal_ = Decimal_ + " " + Centaine(EnTexte) + " " + GrosNombre(J)
  89. End If
  90.  
  91. End If
  92.  
  93. Case Else
  94. If Centaine(EnTexte) <> "" Then
  95. If Decimal_ = "" Then
  96. Decimal_ = Centaine(EnTexte) + " " + GrosNombre(J)
  97. ElseIf Decimal_ <> "" Then
  98. Decimal_ = Decimal_ + " " + Centaine(EnTexte) + " " + GrosNombre(J)
  99. End If
  100. End If
  101.  
  102. End Select
  103.  
  104.  
  105. Etape = Etape - 1
  106. J = Etape - 1
  107.  
  108. Next i
  109.  
  110. End If
  111.  
  112.  
  113. 'Extraire les caract?res entiers
  114. '-----------------------------------
  115. Val_Entier = Int(Abs(valeur))
  116. Val_Entier = FormatCaracter(CStr(Val_Entier))
  117.  
  118. Stade = (Len(Val_Entier) / 3)
  119. J = Stade - 1
  120. Etape = Stade
  121. Texte_ = ""
  122.  
  123. For i = 0 To Stade - 1
  124. EnTexte = ""
  125. EnTexte = Mid(Val_Entier, (i * 3) + 1, 3)
  126.  
  127.  
  128. Select Case Etape
  129. Case 2
  130. If Centaine(EnTexte) = "un" Then
  131. Texte_ = GrosNombre(J)
  132. ElseIf Centaine(EnTexte) <> "un" And Centaine(EnTexte) <> "" Then
  133. If Texte_ = "" Then
  134. Texte_ = Centaine(EnTexte) + " " + GrosNombre(J)
  135. ElseIf Texte_ <> "" Then
  136. Texte_ = Texte_ + " " + Centaine(EnTexte) + " " + GrosNombre(J)
  137. End If
  138. End If
  139. Case Else
  140. If Centaine(EnTexte) <> "" Then
  141. If Texte_ = "" Then
  142. Texte_ = Centaine(EnTexte) + " " + GrosNombre(J)
  143. ElseIf Texte_ <> "" Then
  144. Texte_ = Texte_ + " " + Centaine(EnTexte) + " " + GrosNombre(J)
  145. End If
  146.  
  147. End If
  148.  
  149. End Select
  150.  
  151. Etape = Etape - 1
  152. J = Etape - 1
  153.  
  154. Next i
  155.  
  156. Dim Resultat_Traitement As String
  157.  
  158. If Dec = True Then
  159. Resultat_Traitement = Texte_ + "euro(s) et " + Decimal_ + "cent(s)."
  160. Else: Dec = False
  161. Resultat_Traitement = Texte_ + "euro(s)."
  162. End If
  163.  
  164.  
  165. Dim Tableau() As String
  166. Dim y As Integer
  167. Dim z As Integer
  168. Tableau = Split(Resultat_Traitement)
  169.  
  170.  
  171. z = 0
  172. For y = 0 To UBound(Tableau)
  173.  
  174. z = z + Len(Tableau(y))
  175. If TextBox1.Text - z > 0 Then
  176. Cells(ActiveCell.Row, 12) = Cells(ActiveCell.Row, 12) + Tableau(y) + " "
  177. ElseIf TextBox1.Text - z < 0 Then
  178. Cells(ActiveCell.Row, 12) = Cells(ActiveCell.Row, 12) + Chr(10) + Tableau(y) + " "
  179. z = Len(Tableau(y))
  180. End If
  181.  
  182. Next y
  183.  
  184.  
  185. 'Cells(ActiveCell.Row, 5) = Cells(ActiveCell.Row, 5) + "#"
  186. Dim Lng_esp As Integer
  187. Dim t As Integer
  188.  
  189. If TextBox1.Text - z > 0 Then
  190. Lng_esp = TextBox1.Text - z - 1
  191. For t = 1 To Lng_esp - 1
  192. Cells(ActiveCell.Row, 12) = Cells(ActiveCell.Row, 12) + "*"
  193. Next t
  194.  
  195. End If
  196.  
  197.  
  198. ActiveCell.Offset(1, 0).Select
  199.  
  200. End If
  201.  
  202. Loop Until IsEmpty(ActiveCell) = True
  203.  
  204. MaFeuille.Range("E6").Select
  205.  
  206. End Sub
  207.  
  208. Private Function Centaine(Chiffre As String) As String
  209.  
  210. Dim Unit, Dixaine As Integer
  211.  
  212. Unit = Val(Left(Chiffre, 1))
  213. Dixaine = Val(Right(Chiffre, 2))
  214.  
  215. If Unit > 1 Then
  216. Centaine = Nombre(Unit) + " cent " + Nombre(Dixaine)
  217. ElseIf Unit = 1 Then
  218. Centaine = " cent " + Nombre(Dixaine)
  219. ElseIf Unit = 0 Then
  220. Centaine = Nombre(Dixaine)
  221. End If
  222.  
  223. End Function
  224.  
  225. Private Function FormatCaracter(Chiffre As String) As String
  226.  
  227. Select Case Len(Chiffre)
  228. Case 1 To 3
  229. Chiffre = Format(Chiffre, "000")
  230. Case 4 To 6
  231. Chiffre = Format(Chiffre, "000000")
  232. Case 7 To 9
  233. Chiffre = Format(Chiffre, "000000000")
  234. Case 10 To 12
  235. Chiffre = Format(Chiffre, "000000000000")
  236. Case 13 To 15
  237. Chiffre = Format(Chiffre, "000000000000000")
  238. End Select
  239.  
  240. FormatCaracter = Chiffre
  241.  
  242. End Function
  243.  
  244.  
  245.  
  246. Private Sub TextBox1_Change()
  247.  
  248.  
  249. 'V?rifier si le caract?re saisi est num?rique
  250. '-----------------------------------------------
  251. Dim Msg, Style, Title, Help, Ctxt, Response, MyString
  252.  
  253. Msg = "Veuillez saisir une valeur num?rique ..."
  254. Style = vbYes + vbCritical + vbDefaultButton2
  255. Title = "Gestion des Erreurs "
  256. Ctxt = 1000
  257.  
  258. If Not IsNumeric(TextBox1.Text) And _
  259. Not IsNull(TextBox1.Text) And _
  260. TextBox1.Text <> " " Then
  261.  
  262. Response = MsgBox(Msg, Style, Title)
  263.  
  264. End If
  265.  
  266.  
  267.  
  268.  
  269. End Sub
  270.  
Developpez.com décline toute responsabilité quant à l'utilisation des différents éléments téléchargés.
 
 
 
 
Partenaires

PlanetHoster
Ikoula