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


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

convert numbers to letters (french) V2


Copy this code and paste it in your HTML
  1. Public Function ConvNumToAlpha(ByVal Nombre As Double, ByVal Def_EUR__ID1_CHF__ID2_CAD As Double) As String
  2. ' MAJ: http://www.vbfrance.com/codes/TRADUIRE-GROS-CHIFFRES-LETTRES-AVEC-CORRECTION-ORTOGRAPHIQUE_47934.aspx
  3. ' Supporte plusieures devises ainsi que des nombres jusqu'aux quadrillions
  4. ' Tout est dans cette fonction, il n'est pas nécessaire de faire des déclarations au niveau du module
  5. Dim sFormat As String, sTraducteur As String, Chiffre As Integer, ChiffreMem As Integer
  6. Dim I As Integer, X As Integer, sAtome As String, S As String, Group As Integer, GroupMem As Integer
  7. Static CENTAINNES, DIZAINNES, UNITES, DIVERS, PARTICULIER
  8. Static devise, CouranteDevise As Integer, Updated As Boolean
  9. '
  10. If CouranteDevise <> Def_EUR__ID1_CHF__ID2_CAD Then
  11. Updated = False 'changement de divise, on doit alors re-initialiser les variables statiques
  12. CouranteDevise = Def_EUR__ID1_CHF__ID2_CAD
  13. End If
  14. If Not Updated Then 'afin d'économiser le CPU, les tableaux suivants sont mis à jour seulement quand nécessaire
  15. Updated = True
  16. 'DEVISE = Split(" Euro, Franc, Dollar", ",")
  17. UNITES = Split(", un, deux, trois, quatre, cinq, six, sept, huit, neuf, dix, onze, douze, treize, quatorze, quinze, seize, dix-sept, dix-huit, dix-neuf", ",")
  18. DIZAINNES = Split(", dix, vingt, trente, quarante, cinquante, soixante, soixante-dix, quatre-vingt, quatre-vingt-dix", ",")
  19. CENTAINNES = Split(", cent, deux cent, trois cent, quatre cent, cinq cent, six cent, sept cent, huit cent, neuf cent", ",")
  20. PARTICULIER = Split(Chr(71) & Chr(80) & Chr(81) & ", soixante et onze, quatre-vingts, quatre-vingt-un", ",")
  21. 'DIVERS = Split("MmiBbTQ., mille, million, milliard, billion, billiard, trillion, quadrillion, Euro ", ",")
  22. DIVERS = Split("MmiBbTQ., mille, million, milliard, billion, billiard, trillion, quadrillion,", ",")
  23.  
  24. If CouranteDevise Then 'Francs suisses, Dollars canadians
  25. DIZAINNES(7) " septante" : DIZAINNES(8) " huitante" : DIZAINNES(9) = " nonante"
  26. ReDim PARTICULIER(0)
  27. End If
  28. End If
  29. On Error GoTo Fin
  30. '-------------------------------------CDUQCDUTCDUbCDUBCDUiCDUmCDUMCDU.DU-----------------------------
  31. sFormat = Trim(Format$(CDec(Nombre), "### ### ### ### ### ### ### ###.00")) ' Traduire notre nombre au format
  32. sTraducteur = Right$("CDUQCDUTCDUbCDUBCDUiCDUmCDUMCDU.DU", Len(sFormat)) ' compatible avec 'sTraducteur'
  33. 'Text3 = sFormat
  34. If Int(Nombre) 0 Then S "Zéro"
  35. Group = 2
  36. X = InStr(sFormat, " ")
  37. If X Then Group = Val(Mid(sFormat, 1, X))
  38. For I = 1 To Len(sFormat)
  39. Chiffre = Val(Mid$(sFormat, I, 1))
  40. sAtome = Mid$(sTraducteur, I, 1)
  41. Select Case sAtome
  42. Case "U" ' les unités
  43. If Group 1 And Mid(sTraducteur, I + 1, 1) "M" Then ' éviter les 'Un mille'
  44. ElseIf Chiffre = 1 And ChiffreMem > 0 Then ' vingt et un, trente et un
  45. S = S & " et" & UNITES(Chiffre)
  46. ElseIf Chiffre > 1 And ChiffreMem > 0 Then ' vingt-deux, trente-trois
  47. S = S & "-" & LTrim(UNITES(Chiffre))
  48. ElseIf Chiffre Then
  49. If Mid(sFormat, I + 1, 1) "." And GroupMem 0 And Nombre > 1000 Then S = S & " et"
  50. S = S & UNITES(Chiffre)
  51. End If
  52. Case "D" ' les dizainnes
  53. X = InStr(PARTICULIER(0), Chr(Val(Mid$(sFormat, I, 2))))
  54. If X Then 'soixante et onze, quatre-vingts, quatre-vingt-un
  55. S = S & PARTICULIER(X)
  56. I = I + 1 'éviter les prochainnes unités
  57. ElseIf CouranteDevise = 0 And InStr("79", CStr(Chiffre)) > 0 And Val(Mid$(sFormat, I + 1, 1)) > 0 Then
  58. S = S & DIZAINNES(Chiffre - 1)
  59. I = I + 1 'éviter les prochainnes unités
  60. ChiffreMem = Chiffre
  61. Chiffre = Val(Mid$(sFormat, I, 1))
  62. If ChiffreMem = 1 Then ' onze, douze
  63. S = S & UNITES(Chiffre + 10)
  64. Else ' soixante-onze, quatre-vingt-douze
  65. S = S & "-" & LTrim(UNITES(Chiffre + 10))
  66. End If
  67. ElseIf Chiffre = 1 Then
  68. S = S & UNITES(Val(Mid$(sFormat, I + 1, 1) + 10))
  69. I = I + 1
  70. ElseIf Chiffre Then
  71. S = S & DIZAINNES(Chiffre)
  72. End If
  73. Case "C" ' les centainnes
  74. GroupMem = Group
  75. Group = Val(Mid(sFormat, I, 3))
  76. If Chiffre Then
  77. S = S & CENTAINNES(Chiffre)
  78. If Mid$(sFormat, I + 1, 3) = "00." And Chiffre > 1 Then
  79. S S & "s" 'pluriel sur les centainnes: 600 six cents, 601= six cent un
  80. End If
  81. End If
  82. Case Else
  83. X = InStr(DIVERS(0), sAtome)
  84. If X > 0 And Group > 0 Then
  85. S = S & DIVERS(X)
  86. If Group > 1 And InStr("miBbTQ", sAtome) > 0 Then
  87. S = S & "s" ' traiter les pluriels de million, milliard et billion
  88. End If
  89. ElseIf sAtome = "." Then
  90. S = S & DIVERS(X)
  91. End If
  92. End Select
  93. ChiffreMem = Chiffre ' mémoriser ce dernier chiffre
  94. Next
  95. ConvNumToAlpha = UCase(Mid(S, 1, 1)) & Mid(S, 2) ' mettre première lettre en majuscules
  96. Exit Function
  97. Fin:
  98. If Len(Trim(Nombre)) Then MsgBox(Err.Description, vbCritical + vbSystemModal)
  99. End Function

Report this snippet


Comments

RSS Icon Subscribe to comments

You need to login to post a comment.