Conversion de Chiffre en Lettre

Djoe

XLDnaute Nouveau
Bonjour à tous.
et ben voila il y a quelque mois que j'ai commencé à utiliser les modules VBA (nbletter) d'excel que j'ai découvert dans votre forum et petit à petit j'ai réussi a la formulé selon mon besoin (3 chiffre après la virgule, monnaie et sous monnaie, langue etc).
et tout d'un coup j'ai perdu le module suite à une mauvaise manipulation ou je pense que c suite à l'installation de (morefunc) et que je n'ai pas pu entrer pour modifier celle qui concerne la (nbletter) il me demande mot de passe pour pouvoir modifier le contenu de (morefunc) alors j'ai retourné au départ et j'ai téléchargé une module que je pense de votre forum elle est bien sauf que j'ai un seul souci pour le moment et que j'aime bien que vous m'aidez à le résoudre voila 2 exemple:
  • le montant en chiffre étant: (46 479,900)
  • Voila le module qu'est ce qu'elle m'écrit: (Quarante-Six Mille Quatre Cent Soixante-Dix-Neuf Dinars Quatre-Vingt-Dix Millimes)
  • Correction:
    Quarante-Six Mille Quatre Cent Soixante-Dix-Neuf Dinars, Neuf Cent Millimes.
  • ou bien
    Quarante-Six Mille Quatre Cent Soixante-Dix-Neuf Dinars, 900 Millimes.
autres exemple
  • 3 394,500
  • Voila le module qu'est ce qu'elle m'écrit:
    (Trois Mille Trois Cent Quatre-Vingt-Quatorze Dinars Cinquante Millimes)
  • Correction:
    Trois Mille Trois Cent Quatre-Vingt-Quatorze Dinars, Cinq Cent Millimes.
  • ou bien
    Trois Mille Trois Cent Quatre-Vingt-Quatorze Dinars, 500 Millimes.
Merci d'avance et bonne journée à tout le monde

Djoe
 

Djoe

XLDnaute Nouveau
Rebonjour CHALET53
voila je pense qu'il me faut le module qui a servi pour faire la feuille de calcul que tu m'a envoyé
parceque dans mon excel lorsque j'actualise les nombre en toute lettre deviennent tous de #NOM? je pense aussi que le nom de ce module est Nbrelettres si vous l'avez dans votre excel merci de me la faire copier ici sur le forum
Merci encore une fois et bonne journée
 

Djoe

XLDnaute Nouveau
Voila exactement le module qui me convient et que j'ai passé beaucoup de temps à manipuler pour la mettre au format que je veut mais j'ai perdu la forme des centaines après la virgule cad les centaines des sous monnaie alors j'espere que qlq'1 sais comment ajouter sauf la fonction qui permet de choisir le nombre de chiffre après la virgule qu'on peut lire sans remplacer toute ma module parceque j'ai vu qu'en installant d'autre module dans la même fonction on risque de perdre qlq élément comme la langue ou la monnaie ou la disposition des majuscules etc
Allez bonne nuit et à demain
'----------------------------------------------------------------------------------------
'
' Devise =0 aucune
' =1 Euro €
' =2 Dollar $
' =3 €uro €
' =4 Dinar Tunisien Dt
'
' Langue =0 Français
' =1 Belgique
' =2 Suisse
'
' Casse =0 Minuscule
' =1 Majuscule en début de phrase
' =2 Majuscule
' =3 Majuscule en début de chaque mot
'
' ZeroCent =0 Ne mentionne pas les cents s'ils sont égal à 0
' =1 Mentionne toujours les cents
'
'----------------------------------------------------------------------------------------
'
' Conversion limitée à 999 999 999 999 999 ou 9 999 999 999 999,99
'
'----------------------------------------------------------------------------------------

Dim Dev As Long

Function ConvNumberLetter(Nombre As Double, Optional Devise As Long = 0, _
Optional Langue As Long = 0, _
Optional Casse As Long = 0, _
Optional ZeroCent As Long = 0) As String
Dim dblEnt As Double, lDec As Long
Dim bNegatif As Boolean
Dim strDev As String, strCentimes As String

Dev = Devise
If Nombre < 0 Then
bNegatif = True
Nombre = Abs(Nombre)
End If

dblEnt = Int(Nombre)
' 100 Cents = 1 €
' 1000 Millimes = 1 DT
Select Case Devise
Case 0 To 3
lDec = Application.WorksheetFunction.RoundUp((Nombre - dblEnt) * 100, 2)
Case 4
lDec = Application.WorksheetFunction.RoundUp((Nombre - dblEnt) * 1000, 3)
End Select

If lDec = 0 Then
If dblEnt > 999999999999999# Then
ConvNumberLetter = "#TropGrand"
Exit Function
End If
Else
If dblEnt > 9999999999999.99 Then
ConvNumberLetter = "#TropGrand"
Exit Function
End If
End If

Select Case Devise
Case 0
If lDec > 0 Then strDev = " virgule "
Case 1
strDev = " Euro"
If dblEnt >= 1000000 And Right$(dblEnt, 6) = "000000" Then strDev = " d'Euro"
If lDec > 0 Then strCentimes = strCentimes & " Cent"
If lDec > 1 Then strCentimes = strCentimes & "s"
Case 2
strDev = " Dollar"
If lDec > 0 Then strCentimes = strCentimes & " Cent"
Case 3
strDev = " €uro"
If dblEnt >= 1000000 And Right$(dblEnt, 6) = "000000" Then strDev = " d'€uro"
If lDec > 0 Then strCentimes = strCentimes & " Cent"
If lDec > 1 Then strCentimes = strCentimes & "s"
Case 4
strDev = " Dinar"
If dblEnt >= 1000000 And Right$(dblEnt, 6) = "000000" Then strDev = " de Dinars Tunisiens"
If lDec > 0 Then strCentimes = strCentimes & " Millime"
If lDec > 1 Then strCentimes = strCentimes & "s"
End Select

If dblEnt > 1 And Devise <> 0 Then strDev = strDev & "s"
strDev = strDev & " "
If dblEnt = 0 Then
ConvNumberLetter = "zéro " & strDev
Else
ConvNumberLetter = ConvNumEnt(CDbl(dblEnt), Langue) & strDev
End If

If lDec = 0 Then
If Devise <> 0 Then
If ZeroCent = 1 Then
Select Case Devise
Case 0 To 3
ConvNumberLetter = ConvNumberLetter & "zéro Cent"
Case 4
ConvNumberLetter = ConvNumberLetter & "zéro Millime"
End Select
End If
End If
Else
If Devise = 0 Then
ConvNumberLetter = ConvNumberLetter & ConvNumCent(lDec, Langue) & strCentimes
Else
ConvNumberLetter = ConvNumberLetter & ConvNumCent(lDec, Langue) & strCentimes
End If
End If

ConvNumberLetter = Replace(ConvNumberLetter, " ", " ")
If bNegatif Then ConvNumberLetter = "- " & ConvNumberLetter

If Left$(ConvNumberLetter, 1) = " " Then ConvNumberLetter = Right$(ConvNumberLetter, Len(ConvNumberLetter) - 1)
If Right$(ConvNumberLetter, 1) = " " Then ConvNumberLetter = Left$(ConvNumberLetter, Len(ConvNumberLetter) - 1)
Select Case Casse
Case 0
ConvNumberLetter = LCase$(ConvNumberLetter)
Case 1
ConvNumberLetter = UCase$(Left$(ConvNumberLetter, 1)) & LCase$(Right$(ConvNumberLetter, Len(ConvNumberLetter) - 1))
Case 2
ConvNumberLetter = UCase$(ConvNumberLetter)
Case 3
ConvNumberLetter = Application.WorksheetFunction.Proper(ConvNumberLetter)
If Devise = 3 Then ConvNumberLetter = Replace(ConvNumberLetter, "€Uros", "€uros", , , vbTextCompare)
End Select

End Function
 

Djoe

XLDnaute Nouveau
la suite du module:

Private Function ConvNumCent(Nombre As Long, Langue As Long) As String
Dim TabUnit As Variant
Dim lCent As Long, lReste As Long
Dim strReste As String

TabUnit = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf", "dix")
lCent = Int(Nombre / 100)
lReste = Nombre - (lCent * 100)
strReste = ConvNumDizaine(lReste, Langue, False)

Select Case lCent
Case 0
ConvNumCent = strReste
Case 1
If lReste = 0 Then
ConvNumCent = "cent"
Else
ConvNumCent = "cent " & strReste
End If
Case Else
If lReste = 0 Then
ConvNumCent = TabUnit(lCent) & " cents"
Else
ConvNumCent = TabUnit(lCent) & " cent " & strReste
End If
End Select
End Function

Private Function ConvNumDizaine(Nombre As Long, Langue As Long, bDec As Boolean) As String
Dim TabUnit As Variant, TabDiz As Variant
Dim lUnit As Long, lDiz As Long
Dim strLiaison As String

Select Case Dev
Case 0 To 3
If bDec Then
TabDiz = Array("zéro", "", "vingt", "trente", "quarante", "cinquante", _
"soixante", "soixante", "quatre-vingt", "quatre-vingt")
Else
TabDiz = Array("", "", "vingt", "trente", "quarante", "cinquante", _
"soixante", "soixante", "quatre-vingt", "quatre-vingt")
End If
Case 4
If bDec Then
TabDiz = Array("zéro", "", "vingt", "trente", "quarante", "cinquante", _
"soixante", "soixante-dix", "quatre-vingt", "quatre-vingt-dix")
Else
TabDiz = Array("", "", "vingt", "trente", "quarante", "cinquante", _
"soixante", "soixante-dix", "quatre-vingt", "quatre-vingt-dix")
End If
End Select

If Nombre = 0 Then
TabUnit = Array("zéro")
Else
TabUnit = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
"huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", _
"seize", "dix-sept", "dix-huit", "dix-neuf")
End If

If Langue = 1 Then
TabDiz(7) = "septante"
TabDiz(9) = "nonante"
ElseIf Langue = 2 Then
TabDiz(7) = "septante"
TabDiz(8) = "huitante"
TabDiz(9) = "nonante"
End If

lDiz = Int(Nombre / 10)
lUnit = Nombre - (lDiz * 10)
strLiaison = "-"
If lUnit = 1 Then strLiaison = " et "

Select Case lDiz
Case 0
strLiaison = " "
Case 1
lUnit = lUnit + 10
strLiaison = ""
Case 7
If Langue = 0 Then lUnit = lUnit + 10
Case 8
If Langue <> 2 Then strLiaison = "-"
Case 9
If Langue = 0 Then
lUnit = lUnit + 10
strLiaison = "-"
End If
End Select

ConvNumDizaine = TabDiz(lDiz)
If lDiz = 8 And Langue <> 2 And lUnit = 0 Then ConvNumDizaine = ConvNumDizaine & "s"
If TabUnit(lUnit) <> "" Then
ConvNumDizaine = ConvNumDizaine & strLiaison & TabUnit(lUnit)
Else
ConvNumDizaine = ConvNumDizaine
End If
End Function

Private Function ConvNumEnt(Nombre As Double, Langue As Long)
Dim Tmp As Double, dblReste As Double
Dim strTmp As String
Dim iCent As Long, iMille As Long, iMillion As Long
Dim iMilliard As Long, iBillion As Long

Tmp = Nombre - (Int(Nombre / 1000) * 1000)
iCent = CInt(Tmp)
ConvNumEnt = Nz(ConvNumCent(iCent, Langue))
dblReste = Int(Nombre / 1000)
If Tmp = 0 And dblReste = 0 Then Exit Function
Tmp = dblReste - (Int(dblReste / 1000) * 1000)
If Tmp = 0 And dblReste = 0 Then Exit Function
iMille = CInt(Tmp)
strTmp = ConvNumCent(iMille, Langue)

Select Case Tmp
Case 0
Case 1
strTmp = " mille "
Case Else
strTmp = strTmp & " mille "
End Select

If iMille = 0 And iCent > 0 Then ConvNumEnt = "et " & ConvNumEnt
ConvNumEnt = Nz(strTmp) & ConvNumEnt
dblReste = Int(dblReste / 1000)
Tmp = dblReste - (Int(dblReste / 1000) * 1000)
If Tmp = 0 And dblReste = 0 Then Exit Function
iMillion = CInt(Tmp)
strTmp = ConvNumCent(iMillion, Langue)

Select Case Tmp
Case 0
Case 1
strTmp = strTmp & " million "
Case Else
strTmp = strTmp & " millions "
End Select

If iMille = 1 Then ConvNumEnt = "et " & ConvNumEnt
ConvNumEnt = Nz(strTmp) & ConvNumEnt
dblReste = Int(dblReste / 1000)
Tmp = dblReste - (Int(dblReste / 1000) * 1000)
If Tmp = 0 And dblReste = 0 Then Exit Function
iMilliard = CInt(Tmp)
strTmp = ConvNumCent(iMilliard, Langue)

Select Case Tmp
Case 0
Case 1
strTmp = strTmp & " milliard "
Case Else
strTmp = strTmp & " milliards "
End Select

If iMillion = 1 Then ConvNumEnt = "et " & ConvNumEnt
ConvNumEnt = Nz(strTmp) & ConvNumEnt
dblReste = Int(dblReste / 1000)
Tmp = dblReste - (Int(dblReste / 1000) * 1000)
If Tmp = 0 And dblReste = 0 Then Exit Function
iBillion = CInt(Tmp)
strTmp = ConvNumCent(iBillion, Langue)

Select Case Tmp
Case 0
Case 1
strTmp = strTmp & " billion "
Case Else
strTmp = strTmp & " billions "
End Select

If iMilliard = 1 Then ConvNumEnt = "et " & ConvNumEnt
ConvNumEnt = Nz(strTmp) & ConvNumEnt
End Function

Private Function Nz(strNb As String) As String
If strNb <> " zéro" Then Nz = strNb
End Function
 

Djoe

XLDnaute Nouveau
cette module me fait ca
18 972,326 =
Dix-Huit Mille Neuf Cent Soixante-Douze Dinars Trente-Trois Millimes
il faut qu'il soit
Dix-Huit Mille Neuf Cent Soixante-Douze Dinars Trois Cent Vingt Six Millimes
ou Dix-Huit Mille Neuf Cent Soixante-Douze Dinars 326 Millimes
la formule de ce module s'écrit =ConvNumberLetter(K14;4;0;3;1)
Bye
 

ROGER2327

XLDnaute Barbatruc
Bonjour à tous.

Un autre essai.
(Ne prend pas en compte les coutumes belges et suisses.)

Bonne journée.


ℝOGER2327
#8321


Lundi 16 Phalle 143 (Nativité de St Vibescu, pohète et Commémoration de Ste Cuculine d’Ancône - fête Suprême Quarte)
9 Fructidor An CCXXIV, 0,7628h - réglisse
2016-W34-5T01:49:51Z
 

Pièces jointes

  • TND.xlsm
    43.5 KB · Affichages: 121

ROGER2327

XLDnaute Barbatruc
Extension à quelques dialectes périphériques.

ℝOGER2327
#8322


Lundi 16 Phalle 143 (Nativité de St Vibescu, pohète et Commémoration de Ste Cuculine d’Ancône - fête Suprême Quarte)
9 Fructidor An CCXXIV, 3,8966h - réglisse
2016-W34-5T09:21:06Z
 

Pièces jointes

  • Nombres en lettres (2).xlsm
    53.9 KB · Affichages: 128

ROGER2327

XLDnaute Barbatruc
Corrections mineures.
Nettoyage du code.
Extension aux nombres négatifs.
Extension à d'autres devises (MAD, DZD).
La fonction principale est renommée Num_Alph.

ℝOGER2327
#8323


Lundi 16 Phalle 143 (Nativité de St Vibescu, pohète et Commémoration de Ste Cuculine d’Ancône - fête Suprême Quarte)
9 Fructidor An CCXXIV, 6,7354h - réglisse
2016-W34-5T16:09:54Z
 

Pièces jointes

  • Nombres en lettres (3).xlsm
    54.9 KB · Affichages: 153

Djoe

XLDnaute Nouveau
Bonjour encore une fois
Salut Roger
j'ai téléchargé votre fichier mais lorsque j'actualise ce que vous venez de mettre comme exemple le résultat est perdu il m'ecrit #NOM? et dans mon fichier excel là ou j'ai besoin de cette fonction elle ne marche pas (copier coller la formule et changement de la cellule source).
je pense qu'il me faux une copie du module qui fait la formule =Num_Alph(...........) pour que mon excel aussi adopte cette fonction. comme le module que je viens de présenter en haut elle est complété et acceptable pour mon cas et il ne manque que lire les sous monnaies 3 chiffres après la virgule par exemple 500 Millimes au lieu de 50 Millimes ou bien Cinq Cent Millimes au lieu de Cinquante Millimes.
Merci pour votre intervention et aide et à bien tôt.
Djoe
 
Dernière édition:

ROGER2327

XLDnaute Barbatruc
Re...

(...)
je pense qu'il me faux une copie du module qui fait la formule =Num_Alph(...........) pour que mon excel aussi adopte cette fonction.
(...)
C'est certain ! Si le code n'est pas accessible, la fonction ne peut pas s'exécuter correctement.
Il vous faut donc installer le code à un endroit visible par l'appel de fonction.
Pour ce faire, vous pouvez :
  • Ou bien : Installer le fichier Nombres_en_lettres_ROGER2327.txt(voir la pièce jointe) dans votre classeur.
    Marche à suivre :
    1. enregistrer le Nombres_en_lettres_ROGER2327.txt où vous voulez dans votre machine
    2. (facultatif mais conseillé) le renommer Nombres_en_lettres_ROGER2327.bas
    3. ouvrir votre classeur dans Excel
    4. ouvrir l'éditeur de Visual Basic (Alt F11)
    5. ouvrir l'explorateur de projet s'il ne l'est pas (Ctrl R)
    6. dans la liste des projets, repérer le nom de votre classeur
    7. faire clic-droit sur ce nom
    8. cliquer sur Importer un fichier... dans le menu contextuel
    9. naviguer dans l’arborescence pour récupérer le fichier Nombres_en_lettres_ROGER2327.bas
    10. fermer l'éditeur de Visual Basic : le classeur peut alors utiliser le code
  • Ou bien : Copier le contenu de Nombres_en_lettres_ROGER2327.txt dans un module standard de votre classeur.
    Marche à suivre :
    1. ouvrir votre classeur dans Excel
    2. ouvrir l'éditeur de Visual Basic (Alt F11)
    3. créer un module standard ou en choisir un existant
    4. y coller le contenu de Nombres_en_lettres_ROGER2327.txt
    5. fermer l'éditeur de Visual Basic : le classeur peut alors utiliser le code
Bonne soirée.

ℝOGER2327
#8328


Dimanche 22 Phalle 143 (Sainte Dragonne, pyrophage - fête Suprême Seconde)
15 Fructidor An CCXXIV, 7,6427h - truite
2016-W35-4T18:20:33Z
 

Pièces jointes

  • Nombres_en_lettres_ROGER2327.txt
    19.8 KB · Affichages: 97

Discussions similaires

Statistiques des forums

Discussions
312 932
Messages
2 093 725
Membres
105 798
dernier inscrit
Sly67