Chiffres en lettres

J'ai une fonction qui me permet d'avoir des chiffres en
lettres, mais où puis-je avoir la même chose avec les
trait-d'union réglementaire ?

Fonction perso dont j'ai perdu le nom de l'auteur !
A utiliser comme suit : =ChiffresEnLettres(A1)

Dim mot$(25), Résultat$, N$
Dim Virgule, B, K$, nombre$, longueur
Dim cdu$, C$, D$, U$, Et, Tiret

Sub Ajoute(MotSimple$)
'--- ajoute un nouveau terme traduit à la chaine résultat
If Résultat$ <> "" Then
'--- vérifie s'il est nécessaire de coller le nouveau terme au
'--- précédent dans le cas des "S" à rajouter, ou des tirets
If Right$(Résultat$, 1) = "-" Or _
MotSimple$ = "s" Or MotSimple$ = "-" Then
Résultat$ = Résultat$ + MotSimple$
'--- sinon, ajoute le terme après un espace
Else
Résultat$ = Résultat$ + " " + MotSimple$
End If
Else
Résultat$ = MotSimple$
End If
End Sub

Function Equivalent$(Valeur)
'--- recherche le mot équivalent à une valeur numérique
Select Case Valeur
Case Is < 21
Equivalent$ = mot$(Valeur)
Case Else
Equivalent$ = mot$(18 + (Valeur / 10))
End Select
End Function

Function ChiffresEnLettres$(Valeur$)
Dim a$
'--- initialisation du tableau contenant les mots interprétés
mot$(1) = "un": mot$(2) = "deux"
mot$(3) = "trois": mot$(4) = "quatre"
mot$(5) = "cinq": mot$(6) = "six"
mot$(7) = "sept": mot$(8) = "huit"
mot$(9) = "neuf": mot$(10) = "dix"
mot$(11) = "onze": mot$(12) = "douze"
mot$(13) = "treize": mot$(14) = "quatorze"
mot$(15) = "quinze": mot$(16) = "seize"
mot$(20) = "vingt": mot$(21) = "trente"
mot$(22) = "quarante": mot$(23) = "cinquante"
mot$(24) = "soixante": '--- récupération de paramètre passé
a$ = Valeur$ + " "
'--- initialisation des variables de travail
N$ = ""
Virgule = 0
Résultat$ = ""
'--- pour toute la longueur de celui-ci
For B = 1 To Len(a$)
'--- on extrait chacun de ses caractères
K$ = Mid$(a$, B, 1)
Select Case K$
'--- gère les montants négatifs
Case "-"
Ajoute "moins"
'--- si ceux-ci sont numériques, on batit la chaine n$
Case "0" To "9"
N$ = N$ + K$
'--- sinon, on teste si on est arrivé à une virgule
Case Else
If Virgule = 1 Then
'--- les centimes sont comptés sur 2 digits, réajustés de
'--- manière inverse aux euros, puisqu'on lit les unités
'--- et dizaines de manière inversée (0,2F = 20c et
'--- 0,02F,)
N$ = Right$("000" + Left$(N$ + "000", 2), 2)
If Val(N$) = 0 Then N$ = ""
End If
'--- on traduit le nombre stocké dans n$
TraduireEntier N$
'--- puis on détermine son unité en fonction de la présence
'--- ou non d'une virgule
If Virgule = 0 And Val(N$) > 0 Then
Ajoute "euro"
'--- et on accorde l'unité avec le nombre
If Val(N$) > 1 Then Ajoute "s"
ElseIf Virgule = 1 And Val(N$) > 0 Then
Ajoute "centime"
'--- en ajoutant un "s" si nécessaire
If Val(N$) > 1 Then Ajoute "s"
End If
N$ = ""
Select Case K$
Case Chr$(13)
B = B + 1
Case Is < " "
Case ",", "."
Virgule = 1
'--- si une valeur en euros est exprimée, et que le
'--- nombre de centimes est suffisant pour être traité,
'--- on lie les 2 par le mot "et"
If Val(a$) <> 0 And _
Val("0." + Mid$(a$, B + 1)) >= 0.01 Then Ajoute "et"
Case Else
End Select
End Select
Next
ChiffresEnLettres$ = Résultat$
End Function

Sub TraduireEntier(NombreATraduire$)
'--- convertit un nombre entier contenu dans une chaine de caractères
'--- en son équivalent ordinal
nombre$ = NombreATraduire$
If nombre$ <> "" Then
'--- si le nombre est 0, on ne perd pas de temps
If Val(nombre$) = 0 Then
Ajoute "zéro"
Else
'--- sinon, on convertit celui-ci en une chaine de caractères
'--- de longueur multiple de 3, afin de pouvoir la lire par blocs
'--- de 3 caractères
nombre$ = Right$("000", -((Len(nombre$) Mod 3) <> 0) * (3 -
(Len(nombre$) Mod 3))) + nombre$
For longueur = Len(nombre$) To 3 Step -3
cdu$ = Left$(nombre$, 3)
nombre$ = Right$(nombre$, longueur - 3)
'--- on extrait ainsi des ensembles de 3 chiffres, de la
'--- gauche vers la droite
If cdu$ <> "000" Then
'--- dont on tire une valeur de centaines, dizaines et
'--- unités
C$ = Left$(cdu$, 1)
D$ = Mid$(cdu$, 2, 1)
U$ = Right$(cdu$, 1)
'--- on convertit les unités non muettes pour les
'--- centaines
If C$ >= "2" Then Ajoute Equivalent$(Val(C$))
'--- et on traite les 1 muets
If C$ >= "1" Then
Ajoute "cent"
'--- en appliquant les règles d'accords pour les
'--- centaines
If Val(nombre$) = 0 And D$ + U$ = "00" _
And Len(Résultat$) > 4 Then Ajoute "s"
End If
'--- on analyse si le mot ET est nécessaire (21, 31,
'--- 41 ...)
Et = (D$ >= "2") And (U$ = "1")
'--- ainsi que les tirets pour certains couples
'--- dizaines-unités
Tiret = ((D$ >= "2") And (U$ > "1") _
Or (D$ >= "1" And U$ >= "7")) And Not Et
'--- traitement des valeurs 80-99
If D$ >= "8" Then
Ajoute "quatre-vingt"
Et = 0
'--- retenue nécessaire pour 90 à 99
If D$ = "8" Then D$ = "0" _
Else D$ = "1": Tiret = True
'--- et traitement des unités
If U$ > "0" Then Tiret = True Else Ajoute "s"
'--- sinon on traite les valeurs 70 à 79
ElseIf D$ = "7" Then
Ajoute "soixante"
'--- avec une retenue pour les dizaines
D$ = "1"
If U$ <> "1" Then Tiret = True
End If
'--- valeurs entre 10 et 16
If (D$ = "1") And (U$ <= "6") Then
D$ = "0"
U$ = "1" + U$
End If
'--- sinon, on gère toutes les autres dizaines
If D$ >= "1" Then
'--- gère les tirets pour les dizaines composées
If Tiret And D$ = "1" _
And Val(Right$(cdu$, 2)) > 19 Then
Ajoute "-"
End If
'--- traduction de la dizaine...
Ajoute Equivalent$(Val(D$ + "0"))
'--- en accordant l'exception des vingtaines
If D$ + U$ = "20" And C$ <> "0" Then Ajoute "s"
End If
'--- si le mot Et est nécessaire, on l'ajoute
If Et Then Ajoute "et"
'--- ainsi que le tiret, liant une dizaine et une
'--- unité
If Tiret Then Ajoute "-"
'--- puis on traduit l'unité du nombre
If Val(U$) >= 22 Or ((Val(U$) >= 1 And (Val(cdu$) > 1 Or
longueur <> 6))) Then Ajoute Equivalent$(Val(U$))
'--- enfin, la pondération du nombre est respectée,
'--- en ajoutant le multiple nécessaire, et en
'--- l'accordant s'il le faut
Select Case longueur
Case 6: Ajoute "mille"
Case 9: Ajoute "million"
If Val(cdu$) > 1 Then Ajoute "s"
Case 12
Ajoute "milliard"
If Val(cdu$) > 1 Then Ajoute "s"
Case Else
End Select
End If
Next
End If
End If
End Sub

Bonjour,

La meilleure (je sais, ne suis pas objectif parce que je suis en
conflit d'intérêts) ;-)

En zip:

http://perso.wanadoo.fr/frederic.sigonneau/office/Nb2Words.zip

Auto extractible en rar:

http://perso.wanadoo.fr/frederic.sigonneau/office/Nb2Words.exe


D'autres:

(Faudrait bien que quelqu'un botte le derrière à FREEscargot)

http://dj.joss.free.fr/faq.htm#nblettre



"Pierre" <Pierre@quiroule.fr> a écrit dans le message de
news:2058801c45928$11a27580$a101280a@phx.gbl...
Bonjour
J'ai une fonction qui me permet d'avoir des chiffres en
lettres, mais où puis-je avoir la même chose avec les
trait-d'union réglementaire ?
Merci
Pierre