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

Soyez le premier à donner votre avis sur cette source.

Snippet vu 13 611 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

Signaler
cs_yoman64
Messages postés
593
Date d'inscription
samedi 19 janvier 2002
Statut
Membre
Dernière intervention
4 décembre 2008
 -
bah vous pourrier pas adapter vo prog pour le canada ossi pcke tze nous autre on sen fou des euro!
Signaler
skrol29
Messages postés
115
Date d'inscription
vendredi 3 mai 2002
Statut
Membre
Dernière intervention
17 novembre 2014
 -
Ben c'est le cas ! la devise est un paramètre de la fonction.
Tu fais m_ÉcritMontant(201.55,"dollar","cent")
Bon, après si les candiens utilisent n'écrivent ps les nombres de la même façon ben faut le dire. C'est possible, les belges disent 'septente' pour 'soixante-dix'.
Signaler
zaguia
Messages postés
54
Date d'inscription
mercredi 9 janvier 2002
Statut
Membre
Dernière intervention
8 juin 2002
 -
exelent merci :) 9/10
Signaler
cs_Moussetique
Messages postés
13
Date d'inscription
mercredi 27 mars 2002
Statut
Membre
Dernière intervention
23 avril 2010
 -
Salut! ben en fait moi j'ai fait exactement le memes prog, mais cod differemment. Tu peut le trouver a ce lien :
http://www.vbfrance.com/article.aspx?Val=3783

voila et bravo pour ce code, car il faut etre franc je cros qu'il est meiux que le miens ...

a+
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)