Problème conversion chiffres en lettre avec 3 chiffre après la virgule (dinar)

- - Dernière réponse : PapyLuc51
Messages postés
2176
Date d'inscription
dimanche 3 mai 2009
Statut
Membre
Dernière intervention
14 novembre 2019
- 11 nov. 2019 à 09:22
Bonjour,

je dois convertir beaucoup de chiffre ne Lettre pour de la comptabilité.

J'ai trouvé des macro en Euro pour faire ca.

mais j'ai besoin de dinars, changer les intitulé Dinar est a ma porté.

La ou CA se complique c'est que le dinars utilise 3 chiffres après la virgule, des millime et pas des centimes

la conversion se fait mal avec mon macro

exemple 10,651 me donne dix Dinars soixante cinq millime et non dix dinars six cents cinquante et un millime.

Qlq un peux til m'aider ?

voici le macro que j'utilise, si qlq un peux le modifier ou me donner un autre , ca serait supper

Merci a vous





Function chiffrelettre(chiffre) ' Youky

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", "Dinars", "billion", _
"milliard", "million", "mille", "Dinar")
sp = Space(1)
chaine = "00000000000000"
millime = chiffre * 100 - (Int(chiffre) * 100)
chiffre = Str(Int(chiffre)): lg = Len(chiffre) - 1: chiffre = Right(chiffre, lg): lg = Len(chiffre)
If lg < 15 Then chaine = Mid(chaine, 1, (15 - lg)) Else chaine = ""
chiffre = chaine + chiffre
'billions au centaines
gp = 1
For k = 1 To 5
x = Mid(chiffre, gp, 1): c = a(Val(x))
x = Mid(chiffre, gp + 1, 2): d = a(Val(x))
If k = 5 Then
If t2 <> "" And c & d = "" Then mydz = "Dinars" & sp: GoTo fin
If t <> "" And c = "" And d = "un" Then mydz = "un Dinars" & sp: GoTo fin
If t <> "" And t2 = "" And c & d = "" Then mydz = "d'Dinars" & 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(millime)
If t <> "" Then myct = IIf(millime = 1, " millime", " millimes")
If t = "" Then myct = IIf(millime = 1, " millime d'Dinar", " millimes d'Dinar")
If millime = 0 Then d = "": myct = ""
chiffrelettre = t & d & myct
End Function





Configuration: Windows / Chrome 78.0.3904.70
Afficher la suite 

4 réponses

Messages postés
6345
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
15 novembre 2019
409
0
Merci
Bonjour,

Exemple ici:

https://www.bonbache.fr/convertir-les-nombres-en-textes-en-vba-excel-165.html

Il s'agit maintenant de traduire en texte, la devise passée en paramètre ainsi que l'extension des décimales correspondante. Par exemple, on parle de Cents en Euro et de Millimes en Dinar.
Pour ce faire, ajouter les lignes de code suivantes :
Select Case Devise
Case 0
If partieDecimale > 0 Then texteDevise = ' virgule'
Case 1
texteDevise = ' Euro'
If partieDecimale > 0 Then texteCentimes = ' Cents'
Case 2
texteDevise = ' Dollar'
If partieDecimale > 0 Then texteCentimes = ' Cent'
Case 3
texteDevise = ' Dinar'
If partieDecimale = 1 Then texteCentimes = ' Millime'
If partieDecimale > 1 Then texteCentimes = ' Millimes'
End Select


cs_Le Pivert
Messages postés
6345
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
15 novembre 2019
409 -
Bonjour PapyLuc51,

Oui en suivant la procédure et comme tu l'as souligné en changeant les apostrophes ' en guillemets " c'est fait en à peine 10 minutes!

Il y a une erreur aussi ici:

Else If partieEntiere > 9999999999999# Then


corriger en

ElseIf partieEntiere > 9999999999999# Then


à l'attention deVstappers, pour faire le changement rapidement se servir de la boite de dialogue Rechercher.
Les jumelles dans le ruban

se servir de la formule:

=NbEnLettres(A1;3)

Voilà

@+ Le Pivert
PapyLuc51
Messages postés
2176
Date d'inscription
dimanche 3 mai 2009
Statut
Membre
Dernière intervention
14 novembre 2019
439 -
Bonjour,

J'ai fais comme tu l'as mis ElseIf au lieu de Else If ; ça entraîne la suppression d'un End If juste en dessous car le programme relève une erreur.

Cordialement
PapyLuc51
Messages postés
2176
Date d'inscription
dimanche 3 mai 2009
Statut
Membre
Dernière intervention
14 novembre 2019
439 -
Est-il possible de mettre une Case 4 dans la partie Select Case Devise pour ajouter la livre anglaise ?

    Case 4
texteDevise = " Livre"
If partieDecimale = 1 Then texteCentimes = " Penny"
If partieDecimale > 1 Then texteCentimes = " Pennies"


Si oui faut-il changer autre chose ailleurs dans le code initial ?

Et bien sur je compléterai la partie "ArgumentDesc (2)" dans le code supplémentaire décrit plus haut.

Cordialement
cs_Le Pivert
Messages postés
6345
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
15 novembre 2019
409 -
Non je viens d'essayer cela fonctionne.

Tu peux changer de devise rapidement, en te servant d'une cellule dans laquelle tu mets le chiffre de la devise

Quand tu mets =NbEnLettres une boite de dialogue s'ouvre dans laquelle tu mets la cellule du nombre en la sélectionnant, ensuite la cellule de la devise en faisant de même.

Voilà tu as les devises sans avoir à changer la formule manuellement

@+ Le Pivert
PapyLuc51
Messages postés
2176
Date d'inscription
dimanche 3 mai 2009
Statut
Membre
Dernière intervention
14 novembre 2019
439 -
Merci à toi, je n'osai pas tenter mais finalement c'est vrai que ça marche.
Cordialement
Commenter la réponse de cs_Le Pivert
0
Merci
merci pour l'info, des que j'ai 10 min, je me mets dessus
Commenter la réponse de Vstappers
Messages postés
16979
Date d'inscription
dimanche 17 février 2008
Statut
Contributeur
Dernière intervention
12 novembre 2019
3674
0
Merci
Bonsoir le fil,

J'ai eu utilisé ce code, il me semble qu'il y a un bug, dans les décimales

de 0,1 à 0,9 pas de problème mais à 0,10 il retournait 1 cent et également avec un chiffre entier qui précède exemple jusqu'à 1,09 pas de problème à 1,10 erreur retourne un euro un cent à la place de un euro dix cent
il semblerait que le problème se répète à chaque dizaine 0,20 comme à 0,30 etc ...
je regarde de mon côté comment y remédier à part que j'ai commis une erreur de transcription
Mike-31
Messages postés
16979
Date d'inscription
dimanche 17 février 2008
Statut
Contributeur
Dernière intervention
12 novembre 2019
3674 -
Re,

il faut rectifier le code pour que le pluriel des décimales soit pris en comte pour l'euro comme pour le dollar, il serait également intéressant de compléter le code pour le Yen comme la livre en ajoutant des Cases, j'ai commencé et ça à l'air de tourner pas mal
PapyLuc51
Messages postés
2176
Date d'inscription
dimanche 3 mai 2009
Statut
Membre
Dernière intervention
14 novembre 2019
439 -
Re,

J'ai rectifié pour le dollar, et ajouté le Yen/Yens pour un nombre entier, plus le Sen/Sens pour les décimales

Il reste problème que j'ai soulevé dans mon intervention #15 l'arrondi au centime pour les monnaies à deux décimales et excluant le dinar mais ça je ne sais pas comment faire.

Cordialement
cs_Le Pivert
Messages postés
6345
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
15 novembre 2019
409 -
Re,

Tout simplement comme cela:

Case 1
texteDevise = " Euro"
If partieDecimale = 1 Then texteCentimes = " Cent"
If partieDecimale > 1 Then texteCentimes = " Cents"
If Right(Montant, 1) > 5 Then partieDecimale = partieDecimale + 1'si dernier chiffre plus grand que 5 on ajoute +1
End If


Non cela ne va pas quand on rentre 2 décimales seulement!

le plus simple c'est de mettre la cellule au Format Nombre avec 2 décimales pour les Euros etc..
Et choisir une autre cellule de réception pour les dinars et virgule

Si tu vois une idée pour corriger le code, a toi la main

@+ Le Pivert
cs_Le Pivert
Messages postés
6345
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
15 novembre 2019
409 -
Re,

je réponds à moi même:

Déclarer les variables:

Dim chaine As String
Dim longueur As Integer


ensuite le code pour l'euros, a faire de même pour dollar etc.

Case 1
texteDevise = " Euro"
If partieDecimale = 1 Then texteCentimes = " Cent"
If partieDecimale > 1 Then texteCentimes = " Cents"
If partieDecimale = 0 Then 'si pas de décimale on affiche les entiers
Else 'si décimales
chaine = Split(Montant, ",")(1) 'on cherche les décimales
longueur = Len(chaine) ' longueur de la chaine de décimales
If longueur = 3 Then 'si 3 décimales on arrondi sinon on affiche les 2 décimales
If Right(Montant, 1) > 5 Then partieDecimale = partieDecimale + 1 ' on arrondi
End If
End If


@+ Le Pivert
PapyLuc51
Messages postés
2176
Date d'inscription
dimanche 3 mai 2009
Statut
Membre
Dernière intervention
14 novembre 2019
439 -
Re,

Ça fonctionne. J'ai ajouté les variables à la suite des autres "Dim" et modifié pour les monnaies concernées ; c'est super.

Merci à toi
Cordialement
Commenter la réponse de Mike-31
Messages postés
2284
Date d'inscription
mercredi 3 février 2010
Statut
Membre
Dernière intervention
10 novembre 2019
758
0
Merci
Bonjour,
Pour écrire une valeur en lettres avec des millièmes j'avais modifier une macro dans un fichier de Th.Pourtier
https://www.cjoint.com/c/IKkmYDuelsK
La fonction "MonnaieLettres" est simple à modifier pour afficher des millièmes ( millimes tunisiens ou litres et millilitres):
Dim Decim%, Signe%, Reste#
Signe = Sgn(Nbre)
Decim = Round(Abs(Nbre) - Int(Abs(Nbre)), 2) * 100 '----->> Decim = Round(Abs(Nbre) - Int(Abs(Nbre)), 3) * 1000
Nbre = Int(Abs(Nbre))
L'affichage en chiffres est modifié avec 3 décimales.

Pour oter le "s" à cent devant mille:
Case Is < DixP6
NbL = RTrim(IIf(Nbre \ DixP3 = 1, "", NbL(Nbre \ DixP3, Ut, Dz, Region) & " ") & "mille " & _
NbL(Nbre Mod DixP3, Ut, Dz, Region))
NbL = Replace(NbL, "cents mille", "cent mille") '____________________________________________________________
Case Is < DixP9
NbL = RTrim(NbL(Nbre \ DixP6, Ut, Dz, Region) & " " & "million" & _
IIf(Nbre \ DixP6 > 1, "s ", " ") & NbL(Nbre Mod DixP6, Ut, Dz, Region))
Commenter la réponse de tontong