convertir un nombre en lettre ?

Le
Babedouin
J'ai besoin de cette formule pour convertir le total des mes factures en
lettres !!
J'avais une macros qui fonctionnait avec Office 97 mais maintenant,
impossible de l'utiliser avec 2007 !
Peut etre que ces moi qui ne sais pas comment faire !
Aidez moi SVP !

Merci.
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
AH60
Le #4324481
Bonsoir

SYNTAXE :
=NBTEXTE(Nombre;Langue;Type;Unité1 (sing);Unité1 (plur);Unité2 (sing);Unité2
(plur);Style;Genre1; Genre2)
Transcrit un nombre donné en toutes lettres (13 langues supportées).
Cocher la macro complémentaire Morfun(fonctions complémentaires)
à télécharger apartir de ce site :
http://www.01net.com/telecharger/windows/Bureautique/tableur/fiches/32813.html?fa

EXEMPLES :

(Les attributs modifiés par les paramètres sont indiqués en rouge)

=NBTEXTE(8019) = "Huit mille dix-neuf"
=NBTEXTE(116,58;;;"franc";"francs";"centime";"centimes") = "Cent seize
francs cinquante-huit centimes"
=NBTEXTE(43,01;;;"euro et";;"cent";"cents") = "Quarante-trois euro et un cent"
=NBTEXTE(53;;1;"euro";;"cent";"cents") = "Cinquante-trois euro zéro cent"
=NBTEXTE(643158;;;;;;;2) = "SIX CENT QUARANTE-TROIS MILLE CENT CINQUANTE-HUIT"
=NBTEXTE(95,8;8;;"francs";"franc";"centime";"centimes") = "Nonante-cinq
franc huitante centimes" (Suisse)
=NBTEXTE(9567;2;;"dollar";"dollars") = "Nine thousand five hundred
sixty-seven dollars" (Anglais)
=NBTEXTE(930571;11) = "Ni hundre og tretti tusen fem hundre og søttien"
(Norvégien)

Cordialement Abed_H





J'ai besoin de cette formule pour convertir le total des mes factures en
lettres !!
J'avais une macros qui fonctionnait avec Office 97 mais maintenant,
impossible de l'utiliser avec 2007 !
Peut etre que ces moi qui ne sais pas comment faire !
Aidez moi SVP !

Merci.


MichDenis
Le #4324371
Attention aux coupures intempestives par le service de messagerie.

- Remerciements à Svm pour ce code si bien fait (svm.vnunet.fr)
'-----------------------------------------------------
Function NumText(Nombre As Currency, Optional Unité As String, _
Optional SousUnité As String, Optional no_chiffres As Integer, _
Optional Separateur As String) As String
Dim PartieEntière As Currency, PartieDécimal As Currency
Dim TxtEntier As String, TxtDécimal As String
PartieEntière = Int(Nombre)
TxtEntier = NumTextEntier(PartieEntière)
If no_chiffres > 0 Then
PartieDécimal = (Nombre - PartieEntière) * 10 ^ no_chiffres
TxtDécimal = Format(PartieDécimal, String(no_chiffres, "0"))
End If
NumText = TxtEntier & Unité & Separateur & TxtDécimal & " " & SousUnité
End Function
'-----------------------------------------------------
Function NumTextEntier(ByVal Entier As Currency) As String
Dim no_Classe As Integer, Classe As Integer
If Entier = 0 Then
NumTextEntier = "Zéro "
Else
While Entier > 0
Classe = Entier - Int(Entier / 1000) * 1000
NumTextEntier = TxtClasse(Classe, no_Classe) & NumTextEntier
no_Classe = no_Classe + 1
Entier = Int(Entier / 1000)
Wend
End If
End Function
'-----------------------------------------------------
Function TxtClasse(Classe As Integer, no_Classe As Integer) As String
Dim Centaine As Integer, Dizaine As Integer, Unité As Integer, Unités2Chiffres As Integer
Dim TxtCentaines As String, TxtDizaines As String, TxtUnités As String
Dim TClasses As Variant, Tdizaines As Variant, TUnités As Variant
TClasses = Array("", "mille", "million", "milliard", "billion")
Tdizaines = Array("", "", "vingt", "trente", "quarante", "cinquante", "soixante", "soixante",
"quatre-vingt", "quatre-vingt")
TUnités = 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 = "mille "
Exit Function
End If

Centaine = Classe 100
Unités2Chiffres = Classe Mod 100
Dizaine = Unités2Chiffres 10
Unité = Unités2Chiffres Mod 10
' Les centaines -----
If Centaine = 1 Then
TxtCentaines = "cent "
ElseIf Centaine > 1 Then
TxtCentaines = TUnités(Centaine) & " cent" & IIf(Unités2Chiffres > 0, " ", "s ")
End If
' Les dizaines ------
TxtDizaines = Tdizaines(Dizaine)
If Unité = 1 And Dizaine > 1 And Dizaine < 8 Then
TxtDizaines = TxtDizaines & "-et"
End If
If Dizaine = 1 Or Dizaine = 7 Or Dizaine = 9 Then
Unité = Unité + 10: Dizaine = 0
End If
TxtDizaines = TxtDizaines & IIf(Unités2Chiffres = 80, "s", "")
If Unités2Chiffres > 19 And Unité > 0 Then
TxtDizaines = TxtDizaines & "-"
ElseIf Dizaine > 0 Then
TxtDizaines = TxtDizaines & " "
End If
' Les unités -------- Espace si unité > 0
TxtUnités = TUnités(Unité) & IIf(Unité > 0, " ", "")
' La classe --------- un 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 & TxtUnités & TxtClasse
End Function
'-----------------------------------------------------

Sub Exemple()

' "deux cent cinquante-six mille trois cent vingt-quatre"
MsgBox NumText(256324)

'"quatre cent trente francs et 50 centimes"
MsgBox NumText(1430569125.5, "Dollars", "cents", 2, " et ")

'
MsgBox NumText(430.5, "francs", "centimes", 2, " et ")

'"quatre cent trente francs 50 centimes"
MsgBox NumText(430.5, "francs", "centimes", 2, " ")

End Sub
'-----------------------------------------------------





"Babedouin"
J'ai besoin de cette formule pour convertir le total des mes factures en
lettres !!
J'avais une macros qui fonctionnait avec Office 97 mais maintenant,
impossible de l'utiliser avec 2007 !
Peut etre que ces moi qui ne sais pas comment faire !
Aidez moi SVP !

Merci.
A COSTA
Le #4324291
Bonjour,
J'aimerais aussi utiliser cette macro.
j'ai un valeur en B2 = 123,56
En B3 j'ai mis la formule =numtext(B2) et le résultat est cent vingt-trois
En B4 la formule =NumTextEntier(B2) et le résultat est cent vingt-quatre
En B5 la formule =TextClasse(B2) et le résultat est #NAME?

Comment dois je faire pour avoir le bon résultat ?
Merci d'avance
A Costa




Attention aux coupures intempestives par le service de messagerie.

- Remerciements à Svm pour ce code si bien fait (svm.vnunet.fr)
'-----------------------------------------------------
Function NumText(Nombre As Currency, Optional Unité As String, _
Optional SousUnité As String, Optional no_chiffres As Integer, _
Optional Separateur As String) As String
Dim PartieEntière As Currency, PartieDécimal As Currency
Dim TxtEntier As String, TxtDécimal As String
PartieEntière = Int(Nombre)
TxtEntier = NumTextEntier(PartieEntière)
If no_chiffres > 0 Then
PartieDécimal = (Nombre - PartieEntière) * 10 ^ no_chiffres
TxtDécimal = Format(PartieDécimal, String(no_chiffres, "0"))
End If
NumText = TxtEntier & Unité & Separateur & TxtDécimal & " " & SousUnité
End Function
'-----------------------------------------------------
Function NumTextEntier(ByVal Entier As Currency) As String
Dim no_Classe As Integer, Classe As Integer
If Entier = 0 Then
NumTextEntier = "Zéro "
Else
While Entier > 0
Classe = Entier - Int(Entier / 1000) * 1000
NumTextEntier = TxtClasse(Classe, no_Classe) & NumTextEntier
no_Classe = no_Classe + 1
Entier = Int(Entier / 1000)
Wend
End If
End Function
'-----------------------------------------------------
Function TxtClasse(Classe As Integer, no_Classe As Integer) As String
Dim Centaine As Integer, Dizaine As Integer, Unité As Integer, Unités2Chiffres As Integer
Dim TxtCentaines As String, TxtDizaines As String, TxtUnités As String
Dim TClasses As Variant, Tdizaines As Variant, TUnités As Variant
TClasses = Array("", "mille", "million", "milliard", "billion")
Tdizaines = Array("", "", "vingt", "trente", "quarante", "cinquante", "soixante", "soixante",
"quatre-vingt", "quatre-vingt")
TUnités = 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 = "mille "
Exit Function
End If

Centaine = Classe 100
Unités2Chiffres = Classe Mod 100
Dizaine = Unités2Chiffres 10
Unité = Unités2Chiffres Mod 10
' Les centaines -----
If Centaine = 1 Then
TxtCentaines = "cent "
ElseIf Centaine > 1 Then
TxtCentaines = TUnités(Centaine) & " cent" & IIf(Unités2Chiffres > 0, " ", "s ")
End If
' Les dizaines ------
TxtDizaines = Tdizaines(Dizaine)
If Unité = 1 And Dizaine > 1 And Dizaine < 8 Then
TxtDizaines = TxtDizaines & "-et"
End If
If Dizaine = 1 Or Dizaine = 7 Or Dizaine = 9 Then
Unité = Unité + 10: Dizaine = 0
End If
TxtDizaines = TxtDizaines & IIf(Unités2Chiffres = 80, "s", "")
If Unités2Chiffres > 19 And Unité > 0 Then
TxtDizaines = TxtDizaines & "-"
ElseIf Dizaine > 0 Then
TxtDizaines = TxtDizaines & " "
End If
' Les unités -------- Espace si unité > 0
TxtUnités = TUnités(Unité) & IIf(Unité > 0, " ", "")
' La classe --------- un 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 & TxtUnités & TxtClasse
End Function
'-----------------------------------------------------

Sub Exemple()

' "deux cent cinquante-six mille trois cent vingt-quatre"
MsgBox NumText(256324)

'"quatre cent trente francs et 50 centimes"
MsgBox NumText(1430569125.5, "Dollars", "cents", 2, " et ")

'
MsgBox NumText(430.5, "francs", "centimes", 2, " et ")

'"quatre cent trente francs 50 centimes"
MsgBox NumText(430.5, "francs", "centimes", 2, " ")

End Sub
'-----------------------------------------------------





"Babedouin"
J'ai besoin de cette formule pour convertir le total des mes factures en
lettres !!
J'avais une macros qui fonctionnait avec Office 97 mais maintenant,
impossible de l'utiliser avec 2007 !
Peut etre que ces moi qui ne sais pas comment faire !
Aidez moi SVP !

Merci.





Babedouin
Le #4324271
Bonjour,
merci pour votre reponse. Cependant j'ai maintenant un autre probleme
directement lie a l'installation de morefun !
Excel plante maintenant a tt bout de champ ! Impossible de travailler plus
de 5 mns!
Que faire pour y remedier ?

Merci encore et a bientot.


Bonsoir

SYNTAXE :
=NBTEXTE(Nombre;Langue;Type;Unité1 (sing);Unité1 (plur);Unité2 (sing);Unité2
(plur);Style;Genre1; Genre2)
Transcrit un nombre donné en toutes lettres (13 langues supportées).
Cocher la macro complémentaire Morfun(fonctions complémentaires)
à télécharger apartir de ce site :
http://www.01net.com/telecharger/windows/Bureautique/tableur/fiches/32813.html?fa

EXEMPLES :

(Les attributs modifiés par les paramètres sont indiqués en rouge)

=NBTEXTE(8019) = "Huit mille dix-neuf"
=NBTEXTE(116,58;;;"franc";"francs";"centime";"centimes") = "Cent seize
francs cinquante-huit centimes"
=NBTEXTE(43,01;;;"euro et";;"cent";"cents") = "Quarante-trois euro et un cent"
=NBTEXTE(53;;1;"euro";;"cent";"cents") = "Cinquante-trois euro zéro cent"
=NBTEXTE(643158;;;;;;;2) = "SIX CENT QUARANTE-TROIS MILLE CENT CINQUANTE-HUIT"
=NBTEXTE(95,8;8;;"francs";"franc";"centime";"centimes") = "Nonante-cinq
franc huitante centimes" (Suisse)
=NBTEXTE(9567;2;;"dollar";"dollars") = "Nine thousand five hundred
sixty-seven dollars" (Anglais)
=NBTEXTE(930571;11) = "Ni hundre og tretti tusen fem hundre og søttien"
(Norvégien)

Cordialement Abed_H





J'ai besoin de cette formule pour convertir le total des mes factures en
lettres !!
J'avais une macros qui fonctionnait avec Office 97 mais maintenant,
impossible de l'utiliser avec 2007 !
Peut etre que ces moi qui ne sais pas comment faire !
Aidez moi SVP !

Merci.




MichDenis
Le #4323991
=NumText(B2;;;2;"et ")
et le résultat affiché est : cent vingt-trois et 56




"A COSTA"
Bonjour,
J'aimerais aussi utiliser cette macro.
j'ai un valeur en B2 = 123,56
En B3 j'ai mis la formule =numtext(B2) et le résultat est cent vingt-trois
En B4 la formule =NumTextEntier(B2) et le résultat est cent vingt-quatre
En B5 la formule =TextClasse(B2) et le résultat est #NAME?

Comment dois je faire pour avoir le bon résultat ?
Merci d'avance
A Costa




Attention aux coupures intempestives par le service de messagerie.

- Remerciements à Svm pour ce code si bien fait (svm.vnunet.fr)
'-----------------------------------------------------
Function NumText(Nombre As Currency, Optional Unité As String, _
Optional SousUnité As String, Optional no_chiffres As Integer, _
Optional Separateur As String) As String
Dim PartieEntière As Currency, PartieDécimal As Currency
Dim TxtEntier As String, TxtDécimal As String
PartieEntière = Int(Nombre)
TxtEntier = NumTextEntier(PartieEntière)
If no_chiffres > 0 Then
PartieDécimal = (Nombre - PartieEntière) * 10 ^ no_chiffres
TxtDécimal = Format(PartieDécimal, String(no_chiffres, "0"))
End If
NumText = TxtEntier & Unité & Separateur & TxtDécimal & " " & SousUnité
End Function
'-----------------------------------------------------
Function NumTextEntier(ByVal Entier As Currency) As String
Dim no_Classe As Integer, Classe As Integer
If Entier = 0 Then
NumTextEntier = "Zéro "
Else
While Entier > 0
Classe = Entier - Int(Entier / 1000) * 1000
NumTextEntier = TxtClasse(Classe, no_Classe) & NumTextEntier
no_Classe = no_Classe + 1
Entier = Int(Entier / 1000)
Wend
End If
End Function
'-----------------------------------------------------
Function TxtClasse(Classe As Integer, no_Classe As Integer) As String
Dim Centaine As Integer, Dizaine As Integer, Unité As Integer, Unités2Chiffres As Integer
Dim TxtCentaines As String, TxtDizaines As String, TxtUnités As String
Dim TClasses As Variant, Tdizaines As Variant, TUnités As Variant
TClasses = Array("", "mille", "million", "milliard", "billion")
Tdizaines = Array("", "", "vingt", "trente", "quarante", "cinquante", "soixante", "soixante",
"quatre-vingt", "quatre-vingt")
TUnités = 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 = "mille "
Exit Function
End If

Centaine = Classe 100
Unités2Chiffres = Classe Mod 100
Dizaine = Unités2Chiffres 10
Unité = Unités2Chiffres Mod 10
' Les centaines -----
If Centaine = 1 Then
TxtCentaines = "cent "
ElseIf Centaine > 1 Then
TxtCentaines = TUnités(Centaine) & " cent" & IIf(Unités2Chiffres > 0, " ", "s ")
End If
' Les dizaines ------
TxtDizaines = Tdizaines(Dizaine)
If Unité = 1 And Dizaine > 1 And Dizaine < 8 Then
TxtDizaines = TxtDizaines & "-et"
End If
If Dizaine = 1 Or Dizaine = 7 Or Dizaine = 9 Then
Unité = Unité + 10: Dizaine = 0
End If
TxtDizaines = TxtDizaines & IIf(Unités2Chiffres = 80, "s", "")
If Unités2Chiffres > 19 And Unité > 0 Then
TxtDizaines = TxtDizaines & "-"
ElseIf Dizaine > 0 Then
TxtDizaines = TxtDizaines & " "
End If
' Les unités -------- Espace si unité > 0
TxtUnités = TUnités(Unité) & IIf(Unité > 0, " ", "")
' La classe --------- un 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 & TxtUnités & TxtClasse
End Function
'-----------------------------------------------------

Sub Exemple()

' "deux cent cinquante-six mille trois cent vingt-quatre"
MsgBox NumText(256324)

'"quatre cent trente francs et 50 centimes"
MsgBox NumText(1430569125.5, "Dollars", "cents", 2, " et ")

'
MsgBox NumText(430.5, "francs", "centimes", 2, " et ")

'"quatre cent trente francs 50 centimes"
MsgBox NumText(430.5, "francs", "centimes", 2, " ")

End Sub
'-----------------------------------------------------





"Babedouin"
J'ai besoin de cette formule pour convertir le total des mes factures en
lettres !!
J'avais une macros qui fonctionnait avec Office 97 mais maintenant,
impossible de l'utiliser avec 2007 !
Peut etre que ces moi qui ne sais pas comment faire !
Aidez moi SVP !

Merci.





A COSTA
Le #4323931
Bonjour et merci
J'ai pensé qu'on pouvait avoir tout en lettres.
Bonne journée
A Costa


=NumText(B2;;;2;"et ")
et le résultat affiché est : cent vingt-trois et 56




"A COSTA"
Bonjour,
J'aimerais aussi utiliser cette macro.
j'ai un valeur en B2 = 123,56
En B3 j'ai mis la formule =numtext(B2) et le résultat est cent vingt-trois
En B4 la formule =NumTextEntier(B2) et le résultat est cent vingt-quatre
En B5 la formule =TextClasse(B2) et le résultat est #NAME?

Comment dois je faire pour avoir le bon résultat ?
Merci d'avance
A Costa




Attention aux coupures intempestives par le service de messagerie.

- Remerciements à Svm pour ce code si bien fait (svm.vnunet.fr)
'-----------------------------------------------------
Function NumText(Nombre As Currency, Optional Unité As String, _
Optional SousUnité As String, Optional no_chiffres As Integer, _
Optional Separateur As String) As String
Dim PartieEntière As Currency, PartieDécimal As Currency
Dim TxtEntier As String, TxtDécimal As String
PartieEntière = Int(Nombre)
TxtEntier = NumTextEntier(PartieEntière)
If no_chiffres > 0 Then
PartieDécimal = (Nombre - PartieEntière) * 10 ^ no_chiffres
TxtDécimal = Format(PartieDécimal, String(no_chiffres, "0"))
End If
NumText = TxtEntier & Unité & Separateur & TxtDécimal & " " & SousUnité
End Function
'-----------------------------------------------------
Function NumTextEntier(ByVal Entier As Currency) As String
Dim no_Classe As Integer, Classe As Integer
If Entier = 0 Then
NumTextEntier = "Zéro "
Else
While Entier > 0
Classe = Entier - Int(Entier / 1000) * 1000
NumTextEntier = TxtClasse(Classe, no_Classe) & NumTextEntier
no_Classe = no_Classe + 1
Entier = Int(Entier / 1000)
Wend
End If
End Function
'-----------------------------------------------------
Function TxtClasse(Classe As Integer, no_Classe As Integer) As String
Dim Centaine As Integer, Dizaine As Integer, Unité As Integer, Unités2Chiffres As Integer
Dim TxtCentaines As String, TxtDizaines As String, TxtUnités As String
Dim TClasses As Variant, Tdizaines As Variant, TUnités As Variant
TClasses = Array("", "mille", "million", "milliard", "billion")
Tdizaines = Array("", "", "vingt", "trente", "quarante", "cinquante", "soixante", "soixante",
"quatre-vingt", "quatre-vingt")
TUnités = 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 = "mille "
Exit Function
End If

Centaine = Classe 100
Unités2Chiffres = Classe Mod 100
Dizaine = Unités2Chiffres 10
Unité = Unités2Chiffres Mod 10
' Les centaines -----
If Centaine = 1 Then
TxtCentaines = "cent "
ElseIf Centaine > 1 Then
TxtCentaines = TUnités(Centaine) & " cent" & IIf(Unités2Chiffres > 0, " ", "s ")
End If
' Les dizaines ------
TxtDizaines = Tdizaines(Dizaine)
If Unité = 1 And Dizaine > 1 And Dizaine < 8 Then
TxtDizaines = TxtDizaines & "-et"
End If
If Dizaine = 1 Or Dizaine = 7 Or Dizaine = 9 Then
Unité = Unité + 10: Dizaine = 0
End If
TxtDizaines = TxtDizaines & IIf(Unités2Chiffres = 80, "s", "")
If Unités2Chiffres > 19 And Unité > 0 Then
TxtDizaines = TxtDizaines & "-"
ElseIf Dizaine > 0 Then
TxtDizaines = TxtDizaines & " "
End If
' Les unités -------- Espace si unité > 0
TxtUnités = TUnités(Unité) & IIf(Unité > 0, " ", "")
' La classe --------- un 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 & TxtUnités & TxtClasse
End Function
'-----------------------------------------------------

Sub Exemple()

' "deux cent cinquante-six mille trois cent vingt-quatre"
MsgBox NumText(256324)

'"quatre cent trente francs et 50 centimes"
MsgBox NumText(1430569125.5, "Dollars", "cents", 2, " et ")

'
MsgBox NumText(430.5, "francs", "centimes", 2, " et ")

'"quatre cent trente francs 50 centimes"
MsgBox NumText(430.5, "francs", "centimes", 2, " ")

End Sub
'-----------------------------------------------------





"Babedouin"
J'ai besoin de cette formule pour convertir le total des mes factures en
lettres !!
J'avais une macros qui fonctionnait avec Office 97 mais maintenant,
impossible de l'utiliser avec 2007 !
Peut etre que ces moi qui ne sais pas comment faire !
Aidez moi SVP !

Merci.










MichDenis
Le #4323831
Il y a ceci ... peut être sur le site de Frédéric Sigonneau, y-a-t-il une version plus récente ?

Attention à ceci dans la procédure :
' Dans la ligne finale.... selon les besoins...
' remplacer "VIRGULE" par "Francs" ou "Euros" ou "Dollards"
' remplacer "CENTIÈMES" par "centimes" ou "cents"
Chiffres_à_Lettres = Trim(Chiffres_à_Lettres & " VIRGULE " & _
TradChaLet("0" & fraction) & " CENTIÈMES ")


Function Chiffres_à_Lettres(nombre)
'JP Pastinelli, mpfe
Chiffres_à_Lettres = ""
virg = InStr(1, nombre, ",") 'instruction à modifier si "." décimal au lieu de ",")
entier = Left(nombre, virg - 1)
fraction = Left(Right(nombre, Len(nombre) - virg), 2)
ztranche = Round(Len(entier) / 3, 0)
If ztranche * 3 < Len(entier) Then
ztranche = ztranche + 1
End If
entier = Right("000" & entier, (3 * (ztranche)))
If (ztranche * 3 <> Len(entier)) Then z = 10 / 0
For itranche = ztranche To 1 Step -1
If itranche = 1 Then unit = ""
If itranche = 2 Then unit = "mille"
If itranche = 3 Then unit = "million"
If itranche = 4 Then unit = "milliard"
If itranche = 5 Then unit = "billion"
If itranche = 6 Then unit = "mille billions"
If itranche = 7 Then unit = "trillion"
If itranche = 8 Then unit = "mille trillions"
If itranche = 9 Then unit = "quatrillion"
If itranche = 10 Then unit = "mille quatrillions"
tranche = Mid(entier, 1 + 3 * (ztranche - itranche), 3)
If ((0 + tranche) <> 1) And (itranche = 3 Or itranche = 4 Or _
itranche = 5 Or itranche = 7 Or itranche = 9) Then unit = unit & "s"
ztrad = TradChaLet(tranche)
If Trim(ztrad) = "zéro" Then Chiffres_à_Lettres = Chiffres_à_Lettres
If Trim(ztrad) = "un" And Trim(unit) = "mille" Then _
Chiffres_à_Lettres = Chiffres_à_Lettres & " " & unit
If Trim(ztrad) = "un" And Trim(unit) <> "mille" Then _
Chiffres_à_Lettres = Chiffres_à_Lettres & " " & ztrad & " " & unit
If Not (Trim(ztrad) = "zéro" Or Trim(ztrad) = "un") Then _
Chiffres_à_Lettres = Chiffres_à_Lettres & " " & ztrad & " " & unit
Next itranche

' Dans la ligne finale.... selon les besoins...
' remplacer "VIRGULE" par "Francs" ou "Euros" ou "Dollards"
' remplacer "CENTIÈMES" par "centimes" ou "cents"
Chiffres_à_Lettres = Trim(Chiffres_à_Lettres & " VIRGULE " & _
TradChaLet("0" & fraction) & " CENTIÈMES ")

End Function

Function TradChaLet(tr3)
Dim chiffres(20) As String
chiffres(0) = "zéro"
chiffres(1) = "un"
chiffres(2) = "deux"
chiffres(3) = "trois"
chiffres(4) = "quatre"
chiffres(5) = "cinq"
chiffres(6) = "six"
chiffres(7) = "sept"
chiffres(8) = "huit"
chiffres(9) = "neuf"
chiffres(10) = "dix"
chiffres(11) = "onze"
chiffres(12) = "douze"
chiffres(13) = "treize"
chiffres(14) = "quatorze"
chiffres(15) = "quinze"
chiffres(16) = "seize"
chiffres(17) = "dix-sept"
chiffres(18) = "dix-huit"
chiffres(19) = "dix-neuf"

' traduction des centaines
Select Case tr3 + 0
Case 0
TradChaLet = "zéro"
Case Else
z1 = Left(tr3, 1)
dz = Right(tr3, 2)
z2 = Right(Left(tr3, 2), 1)
z3 = Right(tr3, 1)
Select Case z1
Case "0"
TradChaLet = ""
Case "1"
TradChaLet = ""
Case Else
TradChaLet = chiffres(0 + z1)
End Select ' Case z1
If z1 = 0 Then TradChaLet = TradChaLet
If z1 = 1 Then TradChaLet = TradChaLet & " " & "cent "
If z1 > 1 Then TradChaLet = TradChaLet & " " & "cents "

' traduction des dizaines et unités
Select Case dz
Case "0"
TradChaLet = TradChaLet & " "
Case "10"
TradChaLet = TradChaLet & " dix"
Case "11"
TradChaLet = TradChaLet & " onze"
Case "12"
TradChaLet = TradChaLet & " douze"
Case "13"
TradChaLet = TradChaLet & " treize"
Case "14"
TradChaLet = TradChaLet & " quatorze"
Case "15"
TradChaLet = TradChaLet & " quinze"
Case "16"
TradChaLet = TradChaLet & " seize"
Case "17"
TradChaLet = TradChaLet & " dix-sept"
Case "18"
TradChaLet = TradChaLet & " dix-huit"
Case "19"
TradChaLet = TradChaLet & " dix-neuf"
Case Else
If (z2 = 2 Or z2 = 3 Or z2 = 4 Or z2 = 5 Or z2 = 6 Or z2 = 8) Then
If z2 = 2 Then TradChaLet = TradChaLet & " vingt"
If z2 = 3 Then TradChaLet = TradChaLet & " trente"
If z2 = 4 Then TradChaLet = TradChaLet & " quarante"
If z2 = 5 Then TradChaLet = TradChaLet & " cinquante"
If z2 = 6 Then TradChaLet = TradChaLet & " soixante"
If z2 = 8 Then TradChaLet = TradChaLet & " quatre-vingt"
If z3 = 1 Then TradChaLet = TradChaLet & " et " & chiffres(z3)
If z3 <> 1 Then TradChaLet = TradChaLet & " " & chiffres(z3)
Else
Select Case z2
Case "7"
TradChaLet = TradChaLet & " soixante"
Case "9"
TradChaLet = TradChaLet & " quatre-vingt"
End Select 'Case z2
If (z2 <> 0 And z3 = 1) Then TradChaLet = TradChaLet & " et " & chiffres(10 + z3)
If (z2 <> 0 And z3 <> 1) Then TradChaLet = TradChaLet & " " & chiffres(10 + z3)
If (z2 = 0 And z3 <> 0) Then TradChaLet = TradChaLet & " " & chiffres(z3)
End If
End Select ' Case dz
End Select 'Case tr3 + 0
End Function




"A COSTA"
Bonjour et merci
J'ai pensé qu'on pouvait avoir tout en lettres.
Bonne journée
A Costa


=NumText(B2;;;2;"et ")
et le résultat affiché est : cent vingt-trois et 56




"A COSTA"
Bonjour,
J'aimerais aussi utiliser cette macro.
j'ai un valeur en B2 = 123,56
En B3 j'ai mis la formule =numtext(B2) et le résultat est cent vingt-trois
En B4 la formule =NumTextEntier(B2) et le résultat est cent vingt-quatre
En B5 la formule =TextClasse(B2) et le résultat est #NAME?

Comment dois je faire pour avoir le bon résultat ?
Merci d'avance
A Costa




Attention aux coupures intempestives par le service de messagerie.

- Remerciements à Svm pour ce code si bien fait (svm.vnunet.fr)
'-----------------------------------------------------
Function NumText(Nombre As Currency, Optional Unité As String, _
Optional SousUnité As String, Optional no_chiffres As Integer, _
Optional Separateur As String) As String
Dim PartieEntière As Currency, PartieDécimal As Currency
Dim TxtEntier As String, TxtDécimal As String
PartieEntière = Int(Nombre)
TxtEntier = NumTextEntier(PartieEntière)
If no_chiffres > 0 Then
PartieDécimal = (Nombre - PartieEntière) * 10 ^ no_chiffres
TxtDécimal = Format(PartieDécimal, String(no_chiffres, "0"))
End If
NumText = TxtEntier & Unité & Separateur & TxtDécimal & " " & SousUnité
End Function
'-----------------------------------------------------
Function NumTextEntier(ByVal Entier As Currency) As String
Dim no_Classe As Integer, Classe As Integer
If Entier = 0 Then
NumTextEntier = "Zéro "
Else
While Entier > 0
Classe = Entier - Int(Entier / 1000) * 1000
NumTextEntier = TxtClasse(Classe, no_Classe) & NumTextEntier
no_Classe = no_Classe + 1
Entier = Int(Entier / 1000)
Wend
End If
End Function
'-----------------------------------------------------
Function TxtClasse(Classe As Integer, no_Classe As Integer) As String
Dim Centaine As Integer, Dizaine As Integer, Unité As Integer, Unités2Chiffres As Integer
Dim TxtCentaines As String, TxtDizaines As String, TxtUnités As String
Dim TClasses As Variant, Tdizaines As Variant, TUnités As Variant
TClasses = Array("", "mille", "million", "milliard", "billion")
Tdizaines = Array("", "", "vingt", "trente", "quarante", "cinquante", "soixante",
"soixante",
"quatre-vingt", "quatre-vingt")
TUnités = 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 = "mille "
Exit Function
End If

Centaine = Classe 100
Unités2Chiffres = Classe Mod 100
Dizaine = Unités2Chiffres 10
Unité = Unités2Chiffres Mod 10
' Les centaines -----
If Centaine = 1 Then
TxtCentaines = "cent "
ElseIf Centaine > 1 Then
TxtCentaines = TUnités(Centaine) & " cent" & IIf(Unités2Chiffres > 0, " ", "s ")
End If
' Les dizaines ------
TxtDizaines = Tdizaines(Dizaine)
If Unité = 1 And Dizaine > 1 And Dizaine < 8 Then
TxtDizaines = TxtDizaines & "-et"
End If
If Dizaine = 1 Or Dizaine = 7 Or Dizaine = 9 Then
Unité = Unité + 10: Dizaine = 0
End If
TxtDizaines = TxtDizaines & IIf(Unités2Chiffres = 80, "s", "")
If Unités2Chiffres > 19 And Unité > 0 Then
TxtDizaines = TxtDizaines & "-"
ElseIf Dizaine > 0 Then
TxtDizaines = TxtDizaines & " "
End If
' Les unités -------- Espace si unité > 0
TxtUnités = TUnités(Unité) & IIf(Unité > 0, " ", "")
' La classe --------- un 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 & TxtUnités & TxtClasse
End Function
'-----------------------------------------------------

Sub Exemple()

' "deux cent cinquante-six mille trois cent vingt-quatre"
MsgBox NumText(256324)

'"quatre cent trente francs et 50 centimes"
MsgBox NumText(1430569125.5, "Dollars", "cents", 2, " et ")

'
MsgBox NumText(430.5, "francs", "centimes", 2, " et ")

'"quatre cent trente francs 50 centimes"
MsgBox NumText(430.5, "francs", "centimes", 2, " ")

End Sub
'-----------------------------------------------------





"Babedouin"
J'ai besoin de cette formule pour convertir le total des mes factures en
lettres !!
J'avais une macros qui fonctionnait avec Office 97 mais maintenant,
impossible de l'utiliser avec 2007 !
Peut etre que ces moi qui ne sais pas comment faire !
Aidez moi SVP !

Merci.











A COSTA
Le #4323771
Re Bonjour
J'avais cette macro mais comme l'autre etait plus petite ...
Function chiffrelettre(s)
Dim a As Variant, gros As Variant
a = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
"huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze",
"seize", "dix sept", _
"dix huit", "dix neuf", "vingt", "vingt et un", "vingt deux", "vingt trois",
"vingt quatre", _
"vingt cinq", "vingt six", "vingt sept", "vingt huit", "vingt neuf",
"trente", "trente et un", _
"trente deux", "trente trois", "trente quatre", "trente cinq", "trente six",
"trente sept", _
"trente huit", "trente neuf", "quarante", "quarante et un", "quarante deux",
"quarante trois", _
"quarante quatre", "quarante cinq", "quarante six", "quarante sept",
"quarante huit", _
"quarante neuf", "cinquante", "cinquante et un", "cinquante deux",
"cinquante trois", _
"cinquante quatre", "cinquante cinq", "cinquante six", "cinquante sept",
"cinquante huit", _
"cinquante neuf", "soixante", "soixante et un", "soixante deux", "soixante
trois", _
"soixante quatre", "soixante cinq", "soixante six", "soixante sept",
"soixante huit", _
"soixante neuf", "soixante dix", "soixante et onze", "soixante douze",
"soixante treize", _
"soixante quatorze", "soixante quinze", "soixante seize", "soixante dix
sept", _
"soixante dix huit", "soixante dix neuf", "quatre-vingts", "quatre-vingt
un", _
"quatre-vingt deux", "quatre-vingt trois", "quatre-vingt quatre",
"quatre-vingt cinq", _
"quatre-vingt six", "quatre-vingt sept", "quatre-vingt huit", "quatre-vingt
neuf", _
"quatre-vingt dix", "quatre-vingt onze", "quatre-vingt douze", "quatre-vingt
treize", _
"quatre-vingt quatorze", "quatre-vingt quinze", "quatre-vingt seize",
"quatre-vingt dix sept", _
"quatre-vingt dix huit", "quatre-vingt dix neuf")
gros = Array("", "billions", "milliards", "millions", "mille", "Euros",
"billion", _
"milliard", "million", "mille", "Euro")
sp = Space(1)
chaine = "00000000000000"
centime = s * 100 - (Int(s) * 100)
s = Str(Int(s)): lg = Len(s) - 1: s = Right(s, lg): lg = Len(s)
If lg < 15 Then chaine = Mid(chaine, 1, (15 - lg)) Else chaine = ""
s = chaine + s
'billions au centaines
gp = 1
For k = 1 To 5
x = Mid(s, gp, 1): c = a(Val(x))
x = Mid(s, gp + 1, 2): d = a(Val(x))
If k = 5 Then
If t2 <> "" And c & d = "" Then mydz = "Euros" & sp: GoTo fin
If t <> "" And c = "" And d = "un" Then mydz = "un Euros" & sp: GoTo fin
If t <> "" And t2 = "" And c & d = "" Then mydz = "d'Euros" & sp: GoTo fin
If t & c & d = "" Then myct = "": mydz = "": GoTo fin
End If
If c & d = "" Then GoTo fin
If d = "" And c <> "" And c <> "un" Then mydz = c & sp & "cents " & gros(k)
& sp: GoTo fin
If d = "" And c = "un" Then mydz = "cent " & gros(k) & sp: GoTo fin
If d = "un" And c = "" Then myct = IIf(k = 4, gros(k) & sp, "un " & gros(k +
5) & sp): GoTo fin
If d <> "" And c = "un" Then mydz = "cent" & sp
If d <> "" And c <> "" And c <> "un" Then mydz = c & sp & "cent" + sp
myct = d & sp & gros(k) & sp
fin:
t2 = mydz & myct
t = t & mydz & myct
mydz = "": myct = ""
gp = gp + 3
Next
d = a(centime)
If t <> "" Then myct = IIf(centime = 1, " centime", " centimes")
If t = "" Then myct = IIf(centime = 1, " centime d'Euro", " centimes d'Euro")
If centime = 0 Then d = "": myct = ""
chiffrelettre = t & d & myct
End Function

Mais je pense que celle ci est encore plus petite que la derniere
Bien à vous
A Costa


Il y a ceci ... peut être sur le site de Frédéric Sigonneau, y-a-t-il une version plus récente ?

Attention à ceci dans la procédure :
' Dans la ligne finale.... selon les besoins...
' remplacer "VIRGULE" par "Francs" ou "Euros" ou "Dollards"
' remplacer "CENTIÈMES" par "centimes" ou "cents"
Chiffres_à_Lettres = Trim(Chiffres_à_Lettres & " VIRGULE " & _
TradChaLet("0" & fraction) & " CENTIÈMES ")


Function Chiffres_à_Lettres(nombre)
'JP Pastinelli, mpfe
Chiffres_à_Lettres = ""
virg = InStr(1, nombre, ",") 'instruction à modifier si "." décimal au lieu de ",")
entier = Left(nombre, virg - 1)
fraction = Left(Right(nombre, Len(nombre) - virg), 2)
ztranche = Round(Len(entier) / 3, 0)
If ztranche * 3 < Len(entier) Then
ztranche = ztranche + 1
End If
entier = Right("000" & entier, (3 * (ztranche)))
If (ztranche * 3 <> Len(entier)) Then z = 10 / 0
For itranche = ztranche To 1 Step -1
If itranche = 1 Then unit = ""
If itranche = 2 Then unit = "mille"
If itranche = 3 Then unit = "million"
If itranche = 4 Then unit = "milliard"
If itranche = 5 Then unit = "billion"
If itranche = 6 Then unit = "mille billions"
If itranche = 7 Then unit = "trillion"
If itranche = 8 Then unit = "mille trillions"
If itranche = 9 Then unit = "quatrillion"
If itranche = 10 Then unit = "mille quatrillions"
tranche = Mid(entier, 1 + 3 * (ztranche - itranche), 3)
If ((0 + tranche) <> 1) And (itranche = 3 Or itranche = 4 Or _
itranche = 5 Or itranche = 7 Or itranche = 9) Then unit = unit & "s"
ztrad = TradChaLet(tranche)
If Trim(ztrad) = "zéro" Then Chiffres_à_Lettres = Chiffres_à_Lettres
If Trim(ztrad) = "un" And Trim(unit) = "mille" Then _
Chiffres_à_Lettres = Chiffres_à_Lettres & " " & unit
If Trim(ztrad) = "un" And Trim(unit) <> "mille" Then _
Chiffres_à_Lettres = Chiffres_à_Lettres & " " & ztrad & " " & unit
If Not (Trim(ztrad) = "zéro" Or Trim(ztrad) = "un") Then _
Chiffres_à_Lettres = Chiffres_à_Lettres & " " & ztrad & " " & unit
Next itranche

' Dans la ligne finale.... selon les besoins...
' remplacer "VIRGULE" par "Francs" ou "Euros" ou "Dollards"
' remplacer "CENTIÈMES" par "centimes" ou "cents"
Chiffres_à_Lettres = Trim(Chiffres_à_Lettres & " VIRGULE " & _
TradChaLet("0" & fraction) & " CENTIÈMES ")

End Function

Function TradChaLet(tr3)
Dim chiffres(20) As String
chiffres(0) = "zéro"
chiffres(1) = "un"
chiffres(2) = "deux"
chiffres(3) = "trois"
chiffres(4) = "quatre"
chiffres(5) = "cinq"
chiffres(6) = "six"
chiffres(7) = "sept"
chiffres(8) = "huit"
chiffres(9) = "neuf"
chiffres(10) = "dix"
chiffres(11) = "onze"
chiffres(12) = "douze"
chiffres(13) = "treize"
chiffres(14) = "quatorze"
chiffres(15) = "quinze"
chiffres(16) = "seize"
chiffres(17) = "dix-sept"
chiffres(18) = "dix-huit"
chiffres(19) = "dix-neuf"

' traduction des centaines
Select Case tr3 + 0
Case 0
TradChaLet = "zéro"
Case Else
z1 = Left(tr3, 1)
dz = Right(tr3, 2)
z2 = Right(Left(tr3, 2), 1)
z3 = Right(tr3, 1)
Select Case z1
Case "0"
TradChaLet = ""
Case "1"
TradChaLet = ""
Case Else
TradChaLet = chiffres(0 + z1)
End Select ' Case z1
If z1 = 0 Then TradChaLet = TradChaLet
If z1 = 1 Then TradChaLet = TradChaLet & " " & "cent "
If z1 > 1 Then TradChaLet = TradChaLet & " " & "cents "

' traduction des dizaines et unités
Select Case dz
Case "0"
TradChaLet = TradChaLet & " "
Case "10"
TradChaLet = TradChaLet & " dix"
Case "11"
TradChaLet = TradChaLet & " onze"
Case "12"
TradChaLet = TradChaLet & " douze"
Case "13"
TradChaLet = TradChaLet & " treize"
Case "14"
TradChaLet = TradChaLet & " quatorze"
Case "15"
TradChaLet = TradChaLet & " quinze"
Case "16"
TradChaLet = TradChaLet & " seize"
Case "17"
TradChaLet = TradChaLet & " dix-sept"
Case "18"
TradChaLet = TradChaLet & " dix-huit"
Case "19"
TradChaLet = TradChaLet & " dix-neuf"
Case Else
If (z2 = 2 Or z2 = 3 Or z2 = 4 Or z2 = 5 Or z2 = 6 Or z2 = 8) Then
If z2 = 2 Then TradChaLet = TradChaLet & " vingt"
If z2 = 3 Then TradChaLet = TradChaLet & " trente"
If z2 = 4 Then TradChaLet = TradChaLet & " quarante"
If z2 = 5 Then TradChaLet = TradChaLet & " cinquante"
If z2 = 6 Then TradChaLet = TradChaLet & " soixante"
If z2 = 8 Then TradChaLet = TradChaLet & " quatre-vingt"
If z3 = 1 Then TradChaLet = TradChaLet & " et " & chiffres(z3)
If z3 <> 1 Then TradChaLet = TradChaLet & " " & chiffres(z3)
Else
Select Case z2
Case "7"
TradChaLet = TradChaLet & " soixante"
Case "9"
TradChaLet = TradChaLet & " quatre-vingt"
End Select 'Case z2
If (z2 <> 0 And z3 = 1) Then TradChaLet = TradChaLet & " et " & chiffres(10 + z3)
If (z2 <> 0 And z3 <> 1) Then TradChaLet = TradChaLet & " " & chiffres(10 + z3)
If (z2 = 0 And z3 <> 0) Then TradChaLet = TradChaLet & " " & chiffres(z3)
End If
End Select ' Case dz
End Select 'Case tr3 + 0
End Function




"A COSTA"
Bonjour et merci
J'ai pensé qu'on pouvait avoir tout en lettres.
Bonne journée
A Costa


=NumText(B2;;;2;"et ")
et le résultat affiché est : cent vingt-trois et 56




"A COSTA"
Bonjour,
J'aimerais aussi utiliser cette macro.
j'ai un valeur en B2 = 123,56
En B3 j'ai mis la formule =numtext(B2) et le résultat est cent vingt-trois
En B4 la formule =NumTextEntier(B2) et le résultat est cent vingt-quatre
En B5 la formule =TextClasse(B2) et le résultat est #NAME?

Comment dois je faire pour avoir le bon résultat ?
Merci d'avance
A Costa




Attention aux coupures intempestives par le service de messagerie.

- Remerciements à Svm pour ce code si bien fait (svm.vnunet.fr)
'-----------------------------------------------------
Function NumText(Nombre As Currency, Optional Unité As String, _
Optional SousUnité As String, Optional no_chiffres As Integer, _
Optional Separateur As String) As String
Dim PartieEntière As Currency, PartieDécimal As Currency
Dim TxtEntier As String, TxtDécimal As String
PartieEntière = Int(Nombre)
TxtEntier = NumTextEntier(PartieEntière)
If no_chiffres > 0 Then
PartieDécimal = (Nombre - PartieEntière) * 10 ^ no_chiffres
TxtDécimal = Format(PartieDécimal, String(no_chiffres, "0"))
End If
NumText = TxtEntier & Unité & Separateur & TxtDécimal & " " & SousUnité
End Function
'-----------------------------------------------------
Function NumTextEntier(ByVal Entier As Currency) As String
Dim no_Classe As Integer, Classe As Integer
If Entier = 0 Then
NumTextEntier = "Zéro "
Else
While Entier > 0
Classe = Entier - Int(Entier / 1000) * 1000
NumTextEntier = TxtClasse(Classe, no_Classe) & NumTextEntier
no_Classe = no_Classe + 1
Entier = Int(Entier / 1000)
Wend
End If
End Function
'-----------------------------------------------------
Function TxtClasse(Classe As Integer, no_Classe As Integer) As String
Dim Centaine As Integer, Dizaine As Integer, Unité As Integer, Unités2Chiffres As Integer
Dim TxtCentaines As String, TxtDizaines As String, TxtUnités As String
Dim TClasses As Variant, Tdizaines As Variant, TUnités As Variant
TClasses = Array("", "mille", "million", "milliard", "billion")
Tdizaines = Array("", "", "vingt", "trente", "quarante", "cinquante", "soixante",
"soixante",
"quatre-vingt", "quatre-vingt")
TUnités = 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 = "mille "
Exit Function
End If

Centaine = Classe 100
Unités2Chiffres = Classe Mod 100
Dizaine = Unités2Chiffres 10
Unité = Unités2Chiffres Mod 10
' Les centaines -----
If Centaine = 1 Then
TxtCentaines = "cent "
ElseIf Centaine > 1 Then
TxtCentaines = TUnités(Centaine) & " cent" & IIf(Unités2Chiffres > 0, " ", "s ")
End If
' Les dizaines ------
TxtDizaines = Tdizaines(Dizaine)
If Unité = 1 And Dizaine > 1 And Dizaine < 8 Then
TxtDizaines = TxtDizaines & "-et"
End If
If Dizaine = 1 Or Dizaine = 7 Or Dizaine = 9 Then
Unité = Unité + 10: Dizaine = 0
End If
TxtDizaines = TxtDizaines & IIf(Unités2Chiffres = 80, "s", "")
If Unités2Chiffres > 19 And Unité > 0 Then
TxtDizaines = TxtDizaines & "-"
ElseIf Dizaine > 0 Then
TxtDizaines = TxtDizaines & " "
End If
' Les unités -------- Espace si unité > 0
TxtUnités = TUnités(Unité) & IIf(Unité > 0, " ", "")
' La classe --------- un 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 & TxtUnités & TxtClasse
End Function
'-----------------------------------------------------

Sub Exemple()

' "deux cent cinquante-six mille trois cent vingt-quatre"
MsgBox NumText(256324)

'"quatre cent trente francs et 50 centimes"
MsgBox NumText(1430569125.5, "Dollars", "cents", 2, " et ")

'
MsgBox NumText(430.5, "francs", "centimes", 2, " et ")

'"quatre cent trente francs 50 centimes"
MsgBox NumText(430.5, "francs", "centimes", 2, " ")

End Sub
'-----------------------------------------------------





"Babedouin"
J'ai besoin de cette formule pour convertir le total des mes factures en
lettres !!
J'avais une macros qui fonctionnait avec Office 97 mais maintenant,
impossible de l'utiliser avec 2007 !
Peut etre que ces moi qui ne sais pas comment faire !
Aidez moi SVP !

Merci.








isabelle
Le #4323661
bonjour Denis,

y a un problème avec cette fonction,
pour 101.10 la réponse est
cent un et onze

isabelle


Il y a ceci ... peut être sur le site de Frédéric Sigonneau, y-a-t-il une version plus récente ?

Attention à ceci dans la procédure :
' Dans la ligne finale.... selon les besoins...
' remplacer "VIRGULE" par "Francs" ou "Euros" ou "Dollards"
' remplacer "CENTIÈMES" par "centimes" ou "cents"
Chiffres_à_Lettres = Trim(Chiffres_à_Lettres & " VIRGULE " & _
TradChaLet("0" & fraction) & " CENTIÈMES ")


Function Chiffres_à_Lettres(nombre)
'JP Pastinelli, mpfe
Chiffres_à_Lettres = ""
virg = InStr(1, nombre, ",") 'instruction à modifier si "." décimal au lieu de ",")
entier = Left(nombre, virg - 1)
fraction = Left(Right(nombre, Len(nombre) - virg), 2)
ztranche = Round(Len(entier) / 3, 0)
If ztranche * 3 < Len(entier) Then
ztranche = ztranche + 1
End If
entier = Right("000" & entier, (3 * (ztranche)))
If (ztranche * 3 <> Len(entier)) Then z = 10 / 0
For itranche = ztranche To 1 Step -1
If itranche = 1 Then unit = ""
If itranche = 2 Then unit = "mille"
If itranche = 3 Then unit = "million"
If itranche = 4 Then unit = "milliard"
If itranche = 5 Then unit = "billion"
If itranche = 6 Then unit = "mille billions"
If itranche = 7 Then unit = "trillion"
If itranche = 8 Then unit = "mille trillions"
If itranche = 9 Then unit = "quatrillion"
If itranche = 10 Then unit = "mille quatrillions"
tranche = Mid(entier, 1 + 3 * (ztranche - itranche), 3)
If ((0 + tranche) <> 1) And (itranche = 3 Or itranche = 4 Or _
itranche = 5 Or itranche = 7 Or itranche = 9) Then unit = unit & "s"
ztrad = TradChaLet(tranche)
If Trim(ztrad) = "zéro" Then Chiffres_à_Lettres = Chiffres_à_Lettres
If Trim(ztrad) = "un" And Trim(unit) = "mille" Then _
Chiffres_à_Lettres = Chiffres_à_Lettres & " " & unit
If Trim(ztrad) = "un" And Trim(unit) <> "mille" Then _
Chiffres_à_Lettres = Chiffres_à_Lettres & " " & ztrad & " " & unit
If Not (Trim(ztrad) = "zéro" Or Trim(ztrad) = "un") Then _
Chiffres_à_Lettres = Chiffres_à_Lettres & " " & ztrad & " " & unit
Next itranche

' Dans la ligne finale.... selon les besoins...
' remplacer "VIRGULE" par "Francs" ou "Euros" ou "Dollards"
' remplacer "CENTIÈMES" par "centimes" ou "cents"
Chiffres_à_Lettres = Trim(Chiffres_à_Lettres & " VIRGULE " & _
TradChaLet("0" & fraction) & " CENTIÈMES ")

End Function

Function TradChaLet(tr3)
Dim chiffres(20) As String
chiffres(0) = "zéro"
chiffres(1) = "un"
chiffres(2) = "deux"
chiffres(3) = "trois"
chiffres(4) = "quatre"
chiffres(5) = "cinq"
chiffres(6) = "six"
chiffres(7) = "sept"
chiffres(8) = "huit"
chiffres(9) = "neuf"
chiffres(10) = "dix"
chiffres(11) = "onze"
chiffres(12) = "douze"
chiffres(13) = "treize"
chiffres(14) = "quatorze"
chiffres(15) = "quinze"
chiffres(16) = "seize"
chiffres(17) = "dix-sept"
chiffres(18) = "dix-huit"
chiffres(19) = "dix-neuf"

' traduction des centaines
Select Case tr3 + 0
Case 0
TradChaLet = "zéro"
Case Else
z1 = Left(tr3, 1)
dz = Right(tr3, 2)
z2 = Right(Left(tr3, 2), 1)
z3 = Right(tr3, 1)
Select Case z1
Case "0"
TradChaLet = ""
Case "1"
TradChaLet = ""
Case Else
TradChaLet = chiffres(0 + z1)
End Select ' Case z1
If z1 = 0 Then TradChaLet = TradChaLet
If z1 = 1 Then TradChaLet = TradChaLet & " " & "cent "
If z1 > 1 Then TradChaLet = TradChaLet & " " & "cents "

' traduction des dizaines et unités
Select Case dz
Case "0"
TradChaLet = TradChaLet & " "
Case "10"
TradChaLet = TradChaLet & " dix"
Case "11"
TradChaLet = TradChaLet & " onze"
Case "12"
TradChaLet = TradChaLet & " douze"
Case "13"
TradChaLet = TradChaLet & " treize"
Case "14"
TradChaLet = TradChaLet & " quatorze"
Case "15"
TradChaLet = TradChaLet & " quinze"
Case "16"
TradChaLet = TradChaLet & " seize"
Case "17"
TradChaLet = TradChaLet & " dix-sept"
Case "18"
TradChaLet = TradChaLet & " dix-huit"
Case "19"
TradChaLet = TradChaLet & " dix-neuf"
Case Else
If (z2 = 2 Or z2 = 3 Or z2 = 4 Or z2 = 5 Or z2 = 6 Or z2 = 8) Then
If z2 = 2 Then TradChaLet = TradChaLet & " vingt"
If z2 = 3 Then TradChaLet = TradChaLet & " trente"
If z2 = 4 Then TradChaLet = TradChaLet & " quarante"
If z2 = 5 Then TradChaLet = TradChaLet & " cinquante"
If z2 = 6 Then TradChaLet = TradChaLet & " soixante"
If z2 = 8 Then TradChaLet = TradChaLet & " quatre-vingt"
If z3 = 1 Then TradChaLet = TradChaLet & " et " & chiffres(z3)
If z3 <> 1 Then TradChaLet = TradChaLet & " " & chiffres(z3)
Else
Select Case z2
Case "7"
TradChaLet = TradChaLet & " soixante"
Case "9"
TradChaLet = TradChaLet & " quatre-vingt"
End Select 'Case z2
If (z2 <> 0 And z3 = 1) Then TradChaLet = TradChaLet & " et " & chiffres(10 + z3)
If (z2 <> 0 And z3 <> 1) Then TradChaLet = TradChaLet & " " & chiffres(10 + z3)
If (z2 = 0 And z3 <> 0) Then TradChaLet = TradChaLet & " " & chiffres(z3)
End If
End Select ' Case dz
End Select 'Case tr3 + 0
End Function




"A COSTA"
Bonjour et merci
J'ai pensé qu'on pouvait avoir tout en lettres.
Bonne journée
A Costa



=NumText(B2;;;2;"et ")
et le résultat affiché est : cent vingt-trois et 56




"A COSTA"
Bonjour,
J'aimerais aussi utiliser cette macro.
j'ai un valeur en B2 = 123,56
En B3 j'ai mis la formule =numtext(B2) et le résultat est cent vingt-trois
En B4 la formule =NumTextEntier(B2) et le résultat est cent vingt-quatre
En B5 la formule =TextClasse(B2) et le résultat est #NAME?

Comment dois je faire pour avoir le bon résultat ?
Merci d'avance
A Costa





Attention aux coupures intempestives par le service de messagerie.

- Remerciements à Svm pour ce code si bien fait (svm.vnunet.fr)
'-----------------------------------------------------
Function NumText(Nombre As Currency, Optional Unité As String, _
Optional SousUnité As String, Optional no_chiffres As Integer, _
Optional Separateur As String) As String
Dim PartieEntière As Currency, PartieDécimal As Currency
Dim TxtEntier As String, TxtDécimal As String
PartieEntière = Int(Nombre)
TxtEntier = NumTextEntier(PartieEntière)
If no_chiffres > 0 Then
PartieDécimal = (Nombre - PartieEntière) * 10 ^ no_chiffres
TxtDécimal = Format(PartieDécimal, String(no_chiffres, "0"))
End If
NumText = TxtEntier & Unité & Separateur & TxtDécimal & " " & SousUnité
End Function
'-----------------------------------------------------
Function NumTextEntier(ByVal Entier As Currency) As String
Dim no_Classe As Integer, Classe As Integer
If Entier = 0 Then
NumTextEntier = "Zéro "
Else
While Entier > 0
Classe = Entier - Int(Entier / 1000) * 1000
NumTextEntier = TxtClasse(Classe, no_Classe) & NumTextEntier
no_Classe = no_Classe + 1
Entier = Int(Entier / 1000)
Wend
End If
End Function
'-----------------------------------------------------
Function TxtClasse(Classe As Integer, no_Classe As Integer) As String
Dim Centaine As Integer, Dizaine As Integer, Unité As Integer, Unités2Chiffres As Integer
Dim TxtCentaines As String, TxtDizaines As String, TxtUnités As String
Dim TClasses As Variant, Tdizaines As Variant, TUnités As Variant
TClasses = Array("", "mille", "million", "milliard", "billion")
Tdizaines = Array("", "", "vingt", "trente", "quarante", "cinquante", "soixante",
"soixante",
"quatre-vingt", "quatre-vingt")
TUnités = 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 = "mille "
Exit Function
End If

Centaine = Classe 100
Unités2Chiffres = Classe Mod 100
Dizaine = Unités2Chiffres 10
Unité = Unités2Chiffres Mod 10
' Les centaines -----
If Centaine = 1 Then
TxtCentaines = "cent "
ElseIf Centaine > 1 Then
TxtCentaines = TUnités(Centaine) & " cent" & IIf(Unités2Chiffres > 0, " ", "s ")
End If
' Les dizaines ------
TxtDizaines = Tdizaines(Dizaine)
If Unité = 1 And Dizaine > 1 And Dizaine < 8 Then
TxtDizaines = TxtDizaines & "-et"
End If
If Dizaine = 1 Or Dizaine = 7 Or Dizaine = 9 Then
Unité = Unité + 10: Dizaine = 0
End If
TxtDizaines = TxtDizaines & IIf(Unités2Chiffres = 80, "s", "")
If Unités2Chiffres > 19 And Unité > 0 Then
TxtDizaines = TxtDizaines & "-"
ElseIf Dizaine > 0 Then
TxtDizaines = TxtDizaines & " "
End If
' Les unités -------- Espace si unité > 0
TxtUnités = TUnités(Unité) & IIf(Unité > 0, " ", "")
' La classe --------- un 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 & TxtUnités & TxtClasse
End Function
'-----------------------------------------------------

Sub Exemple()

' "deux cent cinquante-six mille trois cent vingt-quatre"
MsgBox NumText(256324)

'"quatre cent trente francs et 50 centimes"
MsgBox NumText(1430569125.5, "Dollars", "cents", 2, " et ")

'
MsgBox NumText(430.5, "francs", "centimes", 2, " et ")

'"quatre cent trente francs 50 centimes"
MsgBox NumText(430.5, "francs", "centimes", 2, " ")

End Sub
'-----------------------------------------------------





"Babedouin"
J'ai besoin de cette formule pour convertir le total des mes factures en
lettres !!
J'avais une macros qui fonctionnait avec Office 97 mais maintenant,
impossible de l'utiliser avec 2007 !
Peut etre que ces moi qui ne sais pas comment faire !
Aidez moi SVP !

Merci.















Publicité
Poster une réponse
Anonyme