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.
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.
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.
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" a écrit dans le message de news:
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.
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" <Babedouin@discussions.microsoft.com> a écrit dans le message de news:
831171EF-A7A8-495A-8C9B-CD9E2636AAE6@microsoft.com...
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.
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" a écrit dans le message de news:
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.
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_HJ'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.
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.
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_HJ'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.
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" a écrit dans le message de news:
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.
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" <Babedouin@discussions.microsoft.com> a écrit dans le message de news:
831171EF-A7A8-495A-8C9B-CD9E2636AAE6@microsoft.com...
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.
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" a écrit dans le message de news:
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.
=NumText(B2;;;2;"et ")
et le résultat affiché est : cent vingt-trois et 56
"A COSTA" a écrit dans le message de news:
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 CostaAttention 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" a écrit dans le message de news:
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.
=NumText(B2;;;2;"et ")
et le résultat affiché est : cent vingt-trois et 56
"A COSTA" <ACOSTA@discussions.microsoft.com> a écrit dans le message de news:
83BC182E-41C5-4324-9629-62F66FB8045D@microsoft.com...
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" <Babedouin@discussions.microsoft.com> a écrit dans le message de news:
831171EF-A7A8-495A-8C9B-CD9E2636AAE6@microsoft.com...
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.
=NumText(B2;;;2;"et ")
et le résultat affiché est : cent vingt-trois et 56
"A COSTA" a écrit dans le message de news:
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 CostaAttention 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" a écrit dans le message de news:
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.
=NumText(B2;;;2;"et ")
et le résultat affiché est : cent vingt-trois et 56
"A COSTA" a écrit dans le message de news:
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 CostaAttention 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" a écrit dans le message de news:
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.
=NumText(B2;;;2;"et ")
et le résultat affiché est : cent vingt-trois et 56
"A COSTA" <ACOSTA@discussions.microsoft.com> a écrit dans le message de news:
83BC182E-41C5-4324-9629-62F66FB8045D@microsoft.com...
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" <Babedouin@discussions.microsoft.com> a écrit dans le message de news:
831171EF-A7A8-495A-8C9B-CD9E2636AAE6@microsoft.com...
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.
=NumText(B2;;;2;"et ")
et le résultat affiché est : cent vingt-trois et 56
"A COSTA" a écrit dans le message de news:
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 CostaAttention 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" a écrit dans le message de news:
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.
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" a écrit dans le message de news:
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" a écrit dans le message de news:
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 CostaAttention 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" a écrit dans le message de news:
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.
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" <ACOSTA@discussions.microsoft.com> a écrit dans le message de news:
D5B42602-132F-4A7F-A658-0335F077C676@microsoft.com...
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" <ACOSTA@discussions.microsoft.com> a écrit dans le message de news:
83BC182E-41C5-4324-9629-62F66FB8045D@microsoft.com...
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" <Babedouin@discussions.microsoft.com> a écrit dans le message de news:
831171EF-A7A8-495A-8C9B-CD9E2636AAE6@microsoft.com...
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.
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" a écrit dans le message de news:
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" a écrit dans le message de news:
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 CostaAttention 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" a écrit dans le message de news:
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.
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" a écrit dans le message de news:
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" a écrit dans le message de news:
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 CostaAttention 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" a écrit dans le message de news:
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.
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" <ACOSTA@discussions.microsoft.com> a écrit dans le message de news:
D5B42602-132F-4A7F-A658-0335F077C676@microsoft.com...
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" <ACOSTA@discussions.microsoft.com> a écrit dans le message de news:
83BC182E-41C5-4324-9629-62F66FB8045D@microsoft.com...
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" <Babedouin@discussions.microsoft.com> a écrit dans le message de news:
831171EF-A7A8-495A-8C9B-CD9E2636AAE6@microsoft.com...
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.
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" a écrit dans le message de news:
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" a écrit dans le message de news:
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 CostaAttention 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" a écrit dans le message de news:
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.