Sujet Précédent Sujet Suivant

Svp, je cherche un code VBA afin de traduire les c

Résolu/Fermé
crys23 Messages postés 3 Date d'inscription lundi 16 avril 2018 Statut Membre Dernière intervention 18 avril 2018 - 16 avril 2018 à 19:41
crys23 Messages postés 3 Date d'inscription lundi 16 avril 2018 Statut Membre Dernière intervention 18 avril 2018 - 18 avril 2018 à 08:49
Bonjour,

Svp, je cherche un code VBA afin de traduire les chiffres en lettre avec excel 2016, merci d'avance


A voir également:

2 réponses

Réponse 1 / 2
The_boss_68 Messages postés 925 Date d'inscription dimanche 15 novembre 2015 Statut Membre Dernière intervention 23 avril 2024 174
16 avril 2018 à 20:45
Bonjour,

Mettre ce code dans un module 

 Function chiffrelettre(x)
a = Int(x): b = Round(100 * (x - a), 0)
chiffrelettre = Trim(chiffrelettre_(a)) & IIf(b > 0, " et " & b & " centime" & IIf(b > 1, "s", ""), "")
End Function

Function chiffrelettre_(s)
Dim a As Variant, gros As Variant
a = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
"huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix sept", _
"dix huit", "dix neuf", "vingt", "vingt et un", "vingt deux", "vingt trois", "vingt quatre", _
"vingt cinq", "vingt six", "vingt sept", "vingt huit", "vingt neuf", "trente", "trente et un", _
"trente deux", "trente trois", "trente quatre", "trente cinq", "trente six", "trente sept", _
"trente huit", "trente neuf", "quarante", "quarante et un", "quarante deux", "quarante trois", _
"quarante quatre", "quarante cinq", "quarante six", "quarante sept", "quarante huit", _
"quarante neuf", "cinquante", "cinquante et un", "cinquante deux", "cinquante trois", _
"cinquante quatre", "cinquante cinq", "cinquante six", "cinquante sept", "cinquante huit", _
"cinquante neuf", "soixante", "soixante et un", "soixante deux", "soixante trois", _
"soixante quatre", "soixante cinq", "soixante six", "soixante sept", "soixante huit", _
"soixante neuf", "soixante dix", "soixante et onze", "soixante douze", "soixante treize", _
"soixante quatorze", "soixante quinze", "soixante seize", "soixante dix sept", _
"soixante dix huit", "soixante dix neuf", "quatre-vingts", "quatre-vingt un", _
"quatre-vingt deux", "quatre-vingt trois", "quatre-vingt quatre", "quatre-vingt cinq", _
"quatre-vingt six", "quatre-vingt sept", "quatre-vingt huit", "quatre-vingt neuf", _
"quatre-vingt dix", "quatre-vingt onze", "quatre-vingt douze", "quatre-vingt treize", _
"quatre-vingt quatorze", "quatre-vingt quinze", "quatre-vingt seize", "quatre-vingt dix sept", _
"quatre-vingt dix huit", "quatre-vingt dix neuf")
gros = Array("", "billions", "milliards", "millions", "mille", "euros", "billion", _
"milliard", "million", "mille", "euros")
sp = Space(1)
chaine = "00000000000000"
centime = s * 100 - (Int(s) * 100)
s = Str(Int(s)): lg = Len(s) - 1: s = Right(s, lg): lg = Len(s)
If lg < 15 Then chaine = Mid(chaine, 1, (15 - lg)) Else chaine = ""
s = chaine + s
'billions au centaines
gp = 1
For k = 1 To 5
x = Mid(s, gp, 1): c = a(Val(x))
x = Mid(s, gp + 1, 2): d = a(Val(x))
If k = 5 Then
If t2 <> "" And c & d = "" Then mydz = "euros" & sp: GoTo fin
If t <> "" And c = "" And d = "un" Then mydz = "un euros" & sp: GoTo fin
If t <> "" And t2 = "" And c & d = "" Then mydz = "de euros" & sp: GoTo fin
If t & c & d = "" Then myct = "": mydz = "": GoTo fin
End If
If c & d = "" Then GoTo fin
If d = "" And c <> "" And c <> "un" Then mydz = c & sp & "cents " & gros(k) & sp: GoTo fin
If d = "" And c = "un" Then mydz = "cent " & gros(k) & sp: GoTo fin
If d = "un" And c = "" Then myct = IIf(k = 4, gros(k) & sp, "un " & gros(k + 5) & sp): GoTo fin
If d <> "" And c = "un" Then mydz = "cent" & sp
If d <> "" And c <> "" And c <> "un" Then mydz = c & sp & "cent" + sp
myct = d & sp & gros(k) & sp
fin:
t2 = mydz & myct
t = t & mydz & myct
mydz = "": myct = ""
gp = gp + 3
Next
d = a(centime)
If t <> "" Then myct = IIf(centime = 1, " centime", " centimes")
If t = "" Then myct = IIf(centime = 1, " centime de euros", " centimes de euros")
If centime = 0 Then d = "": myct = ""
chiffrelettre_ = t & d & myct
End Function


Puis mettre cette formule dans la cellule ou l'on veut voir apparaître la somme en lettres par exemple en A2
=chiffrelettre(($a$1))
sachant qu'en A1 il y à la somme en chiffre

Slts
0
crys23 Messages postés 3 Date d'inscription lundi 16 avril 2018 Statut Membre Dernière intervention 18 avril 2018
17 avril 2018 à 19:38
Merci beaucoup....elle fonctionne c bon mais par contre, je souhaiterais changer le nom de la monnaie (elle ne s'affiche qu'en euros) utiliser les francs ...Avez vous une idée???...Si ce n'est pas trop vous demander...Merci d'avance.
0
crys23 Messages postés 3 Date d'inscription lundi 16 avril 2018 Statut Membre Dernière intervention 18 avril 2018
18 avril 2018 à 08:49
Bonjour The_boss_68, Je vous remercie très sincèrement...elle fonctionne.
0
Réponse 2 / 2
The_boss_68 Messages postés 925 Date d'inscription dimanche 15 novembre 2015 Statut Membre Dernière intervention 23 avril 2024 174
17 avril 2018 à 21:35
Voilà pour les Francs 


Function chiffrelettre(x)
a = Int(x): b = Round(100 * (x - a), 0)
chiffrelettre = Trim(chiffrelettre_(a)) & IIf(b > 0, " et " & b & " centime" & IIf(b > 1, "s", ""), "")
End Function

Function chiffrelettre_(s)
Dim a As Variant, gros As Variant
a = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
"huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix sept", _
"dix huit", "dix neuf", "vingt", "vingt et un", "vingt deux", "vingt trois", "vingt quatre", _
"vingt cinq", "vingt six", "vingt sept", "vingt huit", "vingt neuf", "trente", "trente et un", _
"trente deux", "trente trois", "trente quatre", "trente cinq", "trente six", "trente sept", _
"trente huit", "trente neuf", "quarante", "quarante et un", "quarante deux", "quarante trois", _
"quarante quatre", "quarante cinq", "quarante six", "quarante sept", "quarante huit", _
"quarante neuf", "cinquante", "cinquante et un", "cinquante deux", "cinquante trois", _
"cinquante quatre", "cinquante cinq", "cinquante six", "cinquante sept", "cinquante huit", _
"cinquante neuf", "soixante", "soixante et un", "soixante deux", "soixante trois", _
"soixante quatre", "soixante cinq", "soixante six", "soixante sept", "soixante huit", _
"soixante neuf", "soixante dix", "soixante et onze", "soixante douze", "soixante treize", _
"soixante quatorze", "soixante quinze", "soixante seize", "soixante dix sept", _
"soixante dix huit", "soixante dix neuf", "quatre-vingts", "quatre-vingt un", _
"quatre-vingt deux", "quatre-vingt trois", "quatre-vingt quatre", "quatre-vingt cinq", _
"quatre-vingt six", "quatre-vingt sept", "quatre-vingt huit", "quatre-vingt neuf", _
"quatre-vingt dix", "quatre-vingt onze", "quatre-vingt douze", "quatre-vingt treize", _
"quatre-vingt quatorze", "quatre-vingt quinze", "quatre-vingt seize", "quatre-vingt dix sept", _
"quatre-vingt dix huit", "quatre-vingt dix neuf")
gros = Array("", "billions", "milliards", "millions", "mille", "francs", "billion", _
"milliard", "million", "mille", "francs")
sp = Space(1)
chaine = "00000000000000"
centime = s * 100 - (Int(s) * 100)
s = Str(Int(s)): lg = Len(s) - 1: s = Right(s, lg): lg = Len(s)
If lg < 15 Then chaine = Mid(chaine, 1, (15 - lg)) Else chaine = ""
s = chaine + s
'billions au centaines
gp = 1
For k = 1 To 5
x = Mid(s, gp, 1): c = a(Val(x))
x = Mid(s, gp + 1, 2): d = a(Val(x))
If k = 5 Then
If t2 <> "" And c & d = "" Then mydz = "francs" & sp: GoTo fin
If t <> "" And c = "" And d = "un" Then mydz = "un francs" & sp: GoTo fin
If t <> "" And t2 = "" And c & d = "" Then mydz = "de francs" & sp: GoTo fin
If t & c & d = "" Then myct = "": mydz = "": GoTo fin
End If
If c & d = "" Then GoTo fin
If d = "" And c <> "" And c <> "un" Then mydz = c & sp & "cents " & gros(k) & sp: GoTo fin
If d = "" And c = "un" Then mydz = "cent " & gros(k) & sp: GoTo fin
If d = "un" And c = "" Then myct = IIf(k = 4, gros(k) & sp, "un " & gros(k + 5) & sp): GoTo fin
If d <> "" And c = "un" Then mydz = "cent" & sp
If d <> "" And c <> "" And c <> "un" Then mydz = c & sp & "cent" + sp
myct = d & sp & gros(k) & sp
fin:
t2 = mydz & myct
t = t & mydz & myct
mydz = "": myct = ""
gp = gp + 3
Next
d = a(centime)
If t <> "" Then myct = IIf(centime = 1, " centime", " centimes")
If t = "" Then myct = IIf(centime = 1, " centime de francs", " centimes de francs")
If centime = 0 Then d = "": myct = ""
chiffrelettre_ = t & d & myct
End Function





Une autre moulure ci-dessous qui génère aussi les centimes en lettres ce qui n'est pas dans la méthode au-dessus
Puis mettre cette formule dans la cellule ou l'on veut voir apparaître la somme en lettres par exemple en A2
=chiffrelettre(($A$2))
sachant qu'en A1 il y à la somme en chiffre 


Function chiffrelettre(s)
Dim A As Variant, gros As Variant
Dim Sp As Variant, Chaine$
Dim centime As Double

A = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
"huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix sept", _
"dix huit", "dix neuf", "vingt", "vingt et un", "vingt deux", "vingt trois", "vingt quatre", _
"vingt cinq", "vingt six", "vingt sept", "vingt huit", "vingt neuf", "trente", "trente et un", _
"trente deux", "trente trois", "trente quatre", "trente cinq", "trente six", "trente sept", _
"trente huit", "trente neuf", "quarante", "quarante et un", "quarante deux", "quarante trois", _
"quarante quatre", "quarante cinq", "quarante six", "quarante sept", "quarante huit", _
"quarante neuf", "cinquante", "cinquante et un", "cinquante deux", "cinquante trois", _
"cinquante quatre", "cinquante cinq", "cinquante six", "cinquante sept", "cinquante huit", _
"cinquante neuf", "soixante", "soixante et un", "soixante deux", "soixante trois", _
"soixante quatre", "soixante cinq", "soixante six", "soixante sept", "soixante huit", _
"soixante neuf", "soixante dix", "soixante et onze", "soixante douze", "soixante treize", _
"soixante quatorze", "soixante quinze", "soixante seize", "soixante dix sept", _
"soixante dix huit", "soixante dix neuf", "quatre-vingts", "quatre-vingt un", _
"quatre-vingt deux", "quatre-vingt trois", "quatre-vingt quatre", "quatre-vingt cinq", _
"quatre-vingt six", "quatre-vingt sept", "quatre-vingt huit", "quatre-vingt neuf", _
"quatre-vingt dix", "quatre-vingt onze", "quatre-vingt douze", "quatre-vingt treize", _
"quatre-vingt quatorze", "quatre-vingt quinze", "quatre-vingt seize", "quatre-vingt dix sept", _
"quatre-vingt dix huit", "quatre-vingt dix neuf")
gros = Array("", "billions", "milliards", "millions", "mille", "francs", "billion", _
"milliard", "million", "mille", "franc")

Sp = Space(1)
Chaine = "00000000000000"
centime = s * 100 - (Int(s) * 100)
s = Str(Int(s)): Lg = Len(s) - 1: s = Right(s, Lg): Lg = Len(s)
If Lg < 15 Then Chaine = Mid(Chaine, 1, (15 - Lg)) Else Chaine = ""
s = Chaine + s
Gp = 1 'billions au centaines
For K = 1 To 5
    x = Mid(s, Gp, 1): c = A(Val(x))
    x = Mid(s, Gp + 1, 2): D = A(Val(x))
    If K = 5 Then
        If t2 <> "" And c & D = "" Then mydz = "francs" & Sp: GoTo Fin
        If t <> "" And c = "" And D = "un" Then mydz = "un franc" & Sp: GoTo Fin
        If t <> "" And t2 = "" And c & D = "" Then mydz = "de franc" & Sp: GoTo Fin
        If t & c & D = "" Then myct = "": mydz = "": GoTo Fin
    End If
    If c & D = "" Then GoTo Fin
    If D = "" And c <> "" And c <> "un" Then mydz = c & Sp & "cents " & gros(K) & Sp: GoTo Fin
    If D = "" And c = "un" Then mydz = "cent " & gros(K) & Sp: GoTo Fin
    If D = "un" And c = "" Then myct = IIf(K = 4, gros(K) & Sp, "un " & gros(K + 5) & Sp): GoTo Fin
    If D <> "" And c = "un" Then mydz = "cent" & Sp
    If D <> "" And c <> "" And c <> "un" Then mydz = c & Sp & "cent" + Sp
    myct = D & Sp & gros(K) & Sp
Fin:
    t2 = mydz & myct
    t = t & mydz & myct
    mydz = "": myct = ""
    Gp = Gp + 3
Next
D = A(centime)
If t <> "" Then myct = IIf(centime = 1, " centime", " centimes")
If t = "" Then myct = IIf(centime = 1, " centime de franc", " centimes de franc")
If centime = 0 Then D = "": myct = ""
chiffrelettre = t & D & myct
End Function



Slts
0

Discussions similaires

Code de renvoi d'appel : Ooredo, Mobilis...
midoou07 -
Camille -

13 réponses
Code de vérification inconnu
Itakk -
Xileh -

7 réponses