Traduction d'un montant numérique en expression littérale

Soyez le premier à donner votre avis sur cette source.

Snippet vu 13 509 fois - Téléchargée 58 fois

Commenter

Contenu du snippet

Cette fonction permet de traduire une valeur numérique en une chaîne texte qui représente l'expression française du montant. La devise est un paramètre de la fonction.

Par exemple :
>>> m_ÉcritMontant(201.55,"euro","centime")
retourne
>>> "Deux cent un euros et cinquante-cinq centimes"

Voilà, c'est surtout utile pour les impressions de chèques.
Enjoy,

Source / Exemple : 


Public Function m_ÉcritMontant(Montant As Currency, Optional Monnaie As String, Optional Centime As String) As String
'---------------------------
'skrol29@freesurf.fr
'Version 1.00, le 01/02/1999
'Version 1.02, le 12/05/2002
'---------------------------

  Dim t1(20) As String
  Dim t2(9) As String
  Dim t3(6) As String
  
  Dim i     As Integer
  Dim i_max As Integer
  Dim i_min As Integer
  Dim m     As String    'Montant numérique sous forme de chaîne formatée "000"
  Dim r     As Integer   'Reste de la longueur à cobler pour avoir un format "000"
  Dim p     As String    'Partie au format "000"
  Dim p1    As Integer   ' partie untié    de P
  Dim p2    As Integer   ' partie dizaine  de P
  Dim p3    As Integer   ' partie centaine de P
  Dim w     As String    'Montant en lettre de P
  Dim x     As String    'Montant en lettre final
  
  t1(0) = ""
  t1(1) = "un"
  t1(2) = "deux"
  t1(3) = "trois"
  t1(4) = "quatre"
  t1(5) = "cinq"
  t1(6) = "six"
  t1(7) = "sept"
  t1(8) = "huit"
  t1(9) = "neuf"
  t1(10) = "dix"
  t1(11) = "onze"
  t1(12) = "douze"
  t1(13) = "treize"
  t1(14) = "quatorze"
  t1(15) = "quinze"
  t1(16) = "seize"
  t1(17) = "dix-sept"
  t1(18) = "dix-huit"
  t1(19) = "dix-neuf"
  t1(20) = "vingt"
  
  t2(0) = ""
  t2(1) = ""
  t2(2) = "vingt"
  t2(3) = "trente"
  t2(4) = "quarante"
  t2(5) = "cinquante"
  t2(6) = "soixante"
  t2(7) = "soixante"
  t2(8) = "quatre-vingt"
  t2(9) = "quatre-vingt"
  
  If Monnaie = "" Then
    Centime = ""
  Else
    If Montant >= 2 Then
      Monnaie = Monnaie & "s"
    End If
    If Centime <> "" Then
      If ((Montant - Fix(Montant)) * 100) >= 2 Then
        Centime = Centime & "s"
      End If
      If ((Montant - Fix(Montant)) * 100) > 0 Then
        Monnaie = Monnaie & " et"
      End If
    End If
  End If
  
  t3(0) = Centime
  t3(1) = Monnaie
  t3(2) = "mille"
  t3(3) = "million"
  t3(4) = "milliard"
  t3(5) = "billiard"
  t3(6) = "triard"
  
  'Mise en forme en chaîne
  m = Format$(Montant, "000.00")
  r = Len(m) Mod 3
  If r > 0 Then
    m = Left$("000", 3 - r) & m
  End If
  i_max = (Len(m) / 3) - 1
  i_min = IIf(Centime = "", 1, 0)
  
  x = ""
  For i = i_min To i_max
  
    p = Mid$(m, Len(m) - (3 * i) - 2, 3)
    p1 = Val(Mid$(p, 3, 1))
    p2 = Val(Mid$(p, 2, 1))
    p3 = Val(Mid$(p, 1, 1))

    'centaines
    Select Case p3
    Case 0
      w = ""
    Case 1
      w = "cent"
    Case Else
      w = t1(p3) & IIf((p1 = 0) And (p2 = 0), " cents", " cent")
    End Select

    'dizaines
    Select Case p2
    Case 0, 1
      'de 0 à 19
      w = w & " " & t1(p1 + 10 * p2)
    Case 7, 9
      'on passe aux valeur qui dépasssent 10
      w = w & " " & t2(p2) & IIf((p1 = 1) And (p2 < 8), " et ", "-") & t1(p1 + 10)
    Case Else
      If (i <= 1) And (p2 = 8) And (p1 = 0) Then
        'Cas ou le montant se termine par "Quatre-vingts" tout rond
        w = w & " " & t2(8) & "s"
      Else
        w = w & " " & t2(p2) & IIf((p1 = 1) And (p2 < 8), " et ", IIf(p1 = 0, "", "-")) & t1(p1)
      End If
    End Select

    w = Trim$(w)

    'On affiche "zéro" si la somme fait "zéro euro"
    If (i > 0) And (Montant < 1) Then
      w = "zéro"
    End If

    If (w <> "") Or ((i = 1) And (i_max > 1)) Then
      If (i = 2) And (p = "001") Then
        'On évite le "un" s'il s'agit d'1 millier d'euro (exemple  : "mille deux cents", et non pas "un mille deux cent")
        x = t3(i) & " " & x
      Else
        'dans le cas classique, on colle la somme
        x = w & " " & t3(i) & " " & x
      End If
    End If

    x = Trim$(x)
  
  Next i
  
  m_ÉcritMontant = UCase$(Left$(x, 1)) & Mid$(x, 2)

End Function

A voir également

Ajouter un commentaire

Commentaires

Commenter la réponse de cs_yoman64
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (skrol29)