Nombre en lettres (français)

Soyez le premier à donner votre avis sur cette source.

Snippet vu 9 268 fois - Téléchargée 35 fois

Contenu du snippet

Permet la conversion en français d'un montant avec unité et sous-unité.

Source / Exemple :


Option Explicit

' --------------------------------------------------------------
' Pour transformer un nombre en texte (Version Française)
' --------------------------------------------------------------
Public Function NumText(ByVal nombre As Currency, _
                        ByVal Unite As String, _
                        ByVal no_chiffres As Integer, _
                        ByVal Sousunite As String) As String
' Converti le nombre en format texte
Dim PartieEntiere As Currency, PartieDecimale As Currency
Dim TxtEntier As String, TxtDecimal As String
Dim Signe As Integer
  Signe = Sgn(nombre)
  nombre = Abs(Round(nombre, no_chiffres))
  PartieEntiere = Int(nombre)
  TxtEntier = NumTextEntier(PartieEntiere)
  If no_chiffres > 0 Then
    PartieDecimale = Round((nombre - PartieEntiere) * 10 ^ no_chiffres, 0)
    If PartieDecimale > 0 Then
      TxtDecimal = NumTextEntier(PartieDecimale)
    Else: TxtDecimal = ""
    End If
  End If
  If Signe = -1 Then TxtEntier = "moins " & TxtEntier
  NumText = TxtEntier & Unite & IIf(TxtDecimal <> "", " et " & TxtDecimal & Sousunite, "")
End Function

Private Function NumTextEntier(ByVal Entier As Currency) As String
' converti un nombre entier en format texte
Dim no_classe As Integer
Dim Classe As Integer
  If Entier = 0 Then
    NumTextEntier = "Zéro"
  Else
    While Entier > 0
      Classe = Entier - Fix(Entier / 1000) * 1000
      NumTextEntier = TxtClasse(Classe, no_classe) & NumTextEntier
      no_classe = no_classe + 1
      Entier = Fix(Entier / 1000)
    Wend
  End If
End Function

Private Function TxtClasse(Classe As Integer, no_classe As Integer) As String
'converti un groupe de chiffres (3 maxi) en sa valeur et complète avec sa classe
Dim Centaine As Integer, Dizaine As Integer, Unite As Integer, Unite2Chiffres As Integer
Dim TxtCentaines As String, TxtDizaines As String, TxtUnites As String
Dim TClasses As Variant, TDizaines As Variant, TUnites As Variant

  TxtClasse = ""
  TClasses = Array("", "mille", "million", "milliard", "billion")
  TDizaines = Array("", "", "vingt", "trente", "quarante", "cinquante", "soixante", "soixante", "quatre-vingt", "quatre-vingt")
  TUnites = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf")
  
  If Classe = 0 Then Exit Function
  ' pas de un pour mille
  If Classe = 1 And no_classe = 1 Then
    TxtClasse = TClasses(1)
    Exit Function
  End If
  Centaine = Classe \ 100
  Unite2Chiffres = Classe Mod 100
  Dizaine = Unite2Chiffres \ 10
  Unite = Unite2Chiffres Mod 10
  ' texte centaines
  If Centaine = 1 Then
    TxtCentaines = "cent"
  ElseIf Centaine > 0 Then
    TxtCentaines = TUnites(Centaine) & " cent" & IIf(Unite2Chiffres > 0, "", "s")
  End If
  If TxtCentaines <> "" And Unite2Chiffres > 0 Then TxtCentaines = TxtCentaines & " "
  ' Texte dizaines
  TxtDizaines = TDizaines(Dizaine)
  If Unite = 1 And Dizaine > 1 And Dizaine < 8 Then TxtDizaines = TxtDizaines & " et"
  If Dizaine = 1 Or Dizaine = 7 Or Dizaine = 9 Then Unite = Unite + 10: Dizaine = 0
  TxtDizaines = TxtDizaines & IIf(Unite2Chiffres = 80, "s", "")
  If Unite2Chiffres > 19 And Unite > 0 Then
    TxtDizaines = TxtDizaines & "-"
  ElseIf Dizaine > 0 Then
    TxtDizaines = TxtDizaines & " "
  End If
  ' Texte unités
  TxtUnites = TUnites(Unite) & IIf(Unite > 0, " ", "")
  ' Texte classe. (1 s sauf pour mille)
  TxtClasse = TClasses(no_classe) & IIf(no_classe > 1 And Classe > 1, "s", "") & IIf(no_classe > 0, " ", "")
  
  ' Résultat
  TxtClasse = TxtCentaines & TxtDizaines & TxtUnites & TxtClasse
End Function

Conclusion :


Je ne suis pas l'auteur original de ce code il provient d'un magazine parut il y a longtemps et dont j'ai déjà) oublié le nom. Je n'ai fait que l'améliorer et l'adapter.
Il fait suite aux différents codes de ce type déjà déposés et propose une version un peu propre de ce type de code.

A voir également

Ajouter un commentaire Commentaires
Messages postés
1
Date d'inscription
lundi 3 janvier 2005
Statut
Membre
Dernière intervention
3 janvier 2005

rien de bien nouveau... si ce n'est une bien meilleure gestion des cas comme "vingt et un mille" au lieu de "vingt un mille"... merci
Messages postés
2169
Date d'inscription
vendredi 20 avril 2001
Statut
Membre
Dernière intervention
30 juin 2009
8
Surement Bien ...mais rien de Nouveau... on n'aurait pu s'en passer :

http://www.vbfrance.com/code.aspx?ID=83
http://www.vbfrance.com/code.aspx?ID=6325
http://www.vbfrance.com/code.aspx?ID=6489
http://www.vbfrance.com/code.aspx?ID=20777
.......
......
.....
....
...
..
.

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.