Conversion de Chiffre en Lettre

Bonjour,

Essaie avec cet exemple issu de ce forum (sans doute)

a+

Bonjour CHALET53
merci beaucoup pour votre intervention
je vais essayer cet exemple et vous tient du résultat
au revoir et à bien tôt
Djoe

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

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

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

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

Bonjour à tous.


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

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

Re,

Le module est dans le fichier : ouvrir l'éditeur VBE
a+

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

Merci Roger pour votre aide
Je vais voir avec
a bien tôt

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

Re...

Djoe à dit:

(...)
je pense qu'il me faux une copie du module qui fait la formule =Num_Alph(...........) pour que mon excel aussi adopte cette fonction.
(...)

Cliquez pour agrandir...

ℝ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

Bonjour à tous,

Je précise mon j’apprécie... Cela est de l'explication.

A+ à tous