XL 2019 Convertir des chiffres en lettres

ajox01

XLDnaute Junior
Bonjour Chers experts,

J'ai besoin de votre aide. Je voudrais une fonction qui me permettra de convertir automatiquement les chiffres monétaires en lettres dans excel.

Exemple: 3 742,50 euros donnera Trois mille sept cent quarante deux Euros Cinquante centimes.

Merci d'avance de votre support

Cordialement
Ajox01
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil, ajox01

•>ajox01
Tu as regardé dans les archives du forum?
(ou à droite de l'écran désormais=> Discussions similaires)
 

patricktoulon

XLDnaute Barbatruc
bonjour
colle ca dans un module
VB:
Option Explicit
Function NblettreFR(chain As String) As String
    Dim t, dixx&, dix&, cxx&, u&, Part, ms, m, Ul, Diz, n&, I&, seg$, cc$, et$, Ss$, R$, md$, euro$, centime
    Ul = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf", "cent ")
    Diz = Array("", "dix", "vingt", "trente", "quarante", "cinquante", "soixante", "soixante-dix", "quatre-vingt", "quatre-vingt-dix", "cent")
    ms = Array("", " decilliard", " decillion", " nonilliard", " nonillion", " octillard", " octillion", " septilliard", " septillion", " sextilliard", " sextillion", " quintilliard ", " Quintillion", " quadrilliard", " quadrillion", " trilliard", " trillion", " Billiard", " billion", " milliard", " million", " mille", "")
    If LCase(chain) Like "*[a-z|:|;|/|\]*" Then NblettreFR = "Invalid Chaine!!": Exit Function
    Part = Split(chain, ","): If Len(Part(0)) > 66 Then NblettreFR = "OutOFF(CAR*66)!!": Exit Function
    euro = IIf(Val(Part(0)) > 999000 And Val(Right(Part(0), 6)) = 0, "d'euro", "euro") & IIf(Part(0) > 1, "s ", " ") & IIf(UBound(Part) > 0, "et ", "")
    centime = IIf(UBound(Part) > 0, "Centime", ""): If UBound(Part) > 0 Then If Part(1) = 0 Then Part = Array(Part(0)): centime = "": euro = Replace(euro, "et", "")
    For n = LBound(Part) To UBound(Part)
        t = Split(Trim(Format(String((300 - Len(Part(n))) Mod 3, "0") & Part(n), WorksheetFunction.Rept(" @@@", Len(String((300 - Len(Part(n))) Mod 3, "0") & Part(n)) / 3))))
        If n = 1 Then If Len(Part(1)) = 1 Then t = Array("0" & Part(1) & "0")    'ajustement centime(0.5 = 0.50)
        m = UBound(ms) - UBound(t)
        For I = LBound(t) To UBound(t)
            cxx = Left(t(I), 1): dixx = Right(t(I), 2): dix = Mid(t(I), 2, 1): u = Right(t(I), 1)
            If cxx = 1 Then cxx = 20: cc = "" Else cc = IIf(cxx > 0, " cent ", "")
            If dix = 9 Or dix = 7 Then dix = dix - 1: u = Val(u) + 10
            If dixx > 9 And dixx < 20 Then dix = 0: u = u + 10
            If dix >= 2 And dix <= 7 And (u = 1 Or u = 11) Then et = " et " Else et = IIf(dix <> 0 And u <> 0, "-", " ")
            If dixx = 80 Then Ss = "s" Else Ss = ""
            If I = UBound(t) - 1 And Part(0) = 1000 Then u = 0
            md = ms(m): If Val(t(I)) > 1 And I < UBound(t) - 1 Then md = md & "s"
            R = R & Application.Trim(Ul(cxx) & cc & Diz(dix) & et & Ul(u)) & Ss & IIf(Val(t(I)) > 0, md, "") & " "
            m = m + 1
        Next
        If Val(Part(0)) = 0 Then euro = ""
        R = R & IIf(n = 0, euro, centime): If n = 1 Then If Part(1) > 1 Then R = R & "s" & IIf(Part(0) = 0, " d'euro", "")
        If Trim(R) = "" Then R = ""
    Next n
    NblettreFR = Trim(R)
End Function
et dans une cellule
exemple

=si(A1>0;NblettreFR(A1);"")
terminé ;)
demo4.gif
 

ajox01

XLDnaute Junior
Bonjour
Merci pour ton aide... C'est parfait avec la devise Euro mais je fais aussi des transactions dans d'autres devises à savoir le dollar ou le franc cfa...

Cordialement
Ajox01
 

patricktoulon

XLDnaute Barbatruc
pour les dollars les écritures en anglais ou pas ?

franc cfa c'est pareil que français
tu peut simplement faire un substitue "euros" vers franc CFA
 

jmfmarques

XLDnaute Accro
Bonjour à tous
Juste pour appeler votre attention sur quelques points, qui nécessitent un paramétrage complet de l'outil de conversion :
Les principaux (et non uniques) paramètres :
- nom de l'unité des entiers de la monnaie - au pluriel et au singulier (peuvent différer de manière significative)
- nom de l'unité des subdivisions (idem que pour les entiers)
- genre (masculin ou féminin) des entiers de la monnaie (on dit cent une roupies et non cent un roupies)
- genre (masculin ou féminin) des subdivisions de la monnaie
 

ajox01

XLDnaute Junior
Bonjour à tous
Juste pour appeler votre attention sur quelques points, qui nécessitent un paramétrage complet de l'outil de conversion :
Les principaux (et non uniques) paramètres :
- nom de l'unité des entiers de la monnaie - au pluriel et au singulier (peuvent différer de manière significative)
- nom de l'unité des subdivisions (idem que pour les entiers)
- genre (masculin ou féminin) des entiers de la monnaie (on dit cent une roupies et non cent un roupies)
- genre (masculin ou féminin) des subdivisions de la monnaie
Bonjour,

Je ne comprends vraiment rien car je suis nouveau dans les macros... Merci de m'envoyer le paramétrage complet svp...

Cordialement
Achirou
 

ajox01

XLDnaute Junior
L'écriture eat en français
Bonjour Patricktoulon,

Merci pour ton aide.... Je voudrais savoir si je dois avoir un classeur séparé pour chaque devise?
Je pars en réunion.... Il y' aura un petit retard dans ma réponse au cas où tu faisais un post.... J'en ai pour la demie journée.

Cordialement
Ajox01
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil, et ses intervenants

Bonjour,
Je ne comprends vraiment rien car je suis nouveau dans les macros...
Si j'étais moi, j'utiliserai plutôt Word qui fait cela tout seul et sans macros ;)
grâce à CARDTEXT
Un petit exemple ci-dessous
Dans Word, faire CTRL+F9
On obtient alors {.}
Saisir alors le nombre à convertir comme ci-dessous
(ici j'ai pris 1111 comme nombre)
{=1111 \*CARDTEXT \*Upper}
Puis faire clic-droit et Mettre à jour les champs
On obtiendra alors : MILLE CENT ONZE

Voila simple, sans macro

PS: Si besoin dans Excel, il suffira de faire CTRL+C puis CTRL+V
 

ajox01

XLDnaute Junior
Bonjour le fil, et ses intervenants


Si j'étais moi, j'utiliserai plutôt Word qui fait cela tout seul et sans macros ;)
grâce à CARDTEXT
Un petit exemple ci-dessous
Dans Word, faire CTRL+F9
On obtient alors {.}
Saisir alors le nombre à convertir comme ci-dessous
(ici j'ai pris 1111 comme nombre)
{=1111 \*CARDTEXT \*Upper}
Puis faire clic-droit et Mettre à jour les champs
On obtiendra alors : MILLE CENT ONZE

Voila simple, sans macro

PS: Si besoin dans Excel, il suffira de faire CTRL+C puis CTRL+V
Merci pour ton support.... mais je cherchais une solution pour Excel....
Cordialement
Ajox01
 

Staple1600

XLDnaute Barbatruc
Re, Bonjour patricktoulon

•>patricktoulon
Oui, c'est moi.
Et le confinement t'offre l'occasion de retrouver le fil en question ;)
(et de tester l'efficacité ou pas du moteur de recherche interne du forum)
Bonne recherche, camarade confiné ;)

PS: Si par extraordinaire, le fil n'est pas retrouvé, je posterai le lien après ma séance de jo(K-SDB-K)gging ;)
 

patricktoulon

XLDnaute Barbatruc
re
ben je le retrouve pas le tire ne dis pas etre cohérent avec le sujet

mais j'ai peché une macro word que j'essaie de faire fonctionner dans vba excel je n y arrive pas
VB:
Sub NombreEnLettre()
Dim MonChamp As Object

Set appw = CreateObject("word.application")
Set docw = appw.documents.Add
appw.Visible = True
x = InputBox("Entrez un nombre")
Set MonChamp = docw.Fields.Add(Range:=Selection.Range, Text:="=" & x & " * cardtext")
MonChamp.Unlink
End Sub
 

Staple1600

XLDnaute Barbatruc
Re

•>patricktoulon
Pourtant... ;)
 

patricktoulon

XLDnaute Barbatruc
re
ben oui mais le tire et le forum c 'est pas jojo
bon toujours est il qu'en fonction et épuré de tout ce qui est pas nécessaire j'aimerais bien l'avoir en latebinding histoir de lui ajouter la transportabilité ;)

VB:
Function convert_number_to_letters_word_Object(num$)
Dim oWS As Worksheet
Dim oOLEWd As OLEObject
Dim oWD As Document, Cts$
' Dans VBE, Menu: Outils/Références:cochez: Microsoft Word XX.0 Object Library )
Cts = Split(num, ",")(1)
Application.ScreenUpdating = False
Set oWS = ActiveSheet
Set oOLEWd = oWS.OLEObjects.Add(ClassType:="Word.Document.8", Link:=False, DisplayAsIcon:=True)
Set oWD = oOLEWd.Object
oWD.Fields.Add Range:=oWD.Range, Type:=wdFieldQuote, Text:="=" & Split(num, ",")(0) & "\*CARDTEXT"
oWD.Range.Characters(Len(oWD.Range.Text)).InsertAfter " EUROS ET " 'Eureka !
oWD.Fields.Add Range:=oWD.Range.Characters(Len(oWD.Range.Text)), Type:=wdFieldQuote, Text:="=" & Cts & "\*CARDTEXT"
oWD.Range.Characters(Len(oWD.Range.Text)).InsertAfter " CENTIMES." 'Alleluia !!!
oWD.Fields.Update
convert_number_to_letters_word_Object = oWD.Range.Text
'On Error Resume Next
If Not oOLEWd Is Nothing Then oOLEWd.Delete
End Function

Sub test()
num$ = InputBox("Saisir un montant:" & Chr(13) & "Ex: 123,89", "Saisie", "123,89")
MsgBox convert_number_to_letters_word_Object(num)
End Sub
voir aussi si les 2 insert ne peuvent pas se faire en un dans la formule
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas