Discussion:
Convertir les chiffres avec les décimales en Lettres
Add Reply
Serano
2017-02-03 08:29:29 UTC
Réponse
Permalink
Raw Message
Bonjour,

Pourriez vous m'indiquer comment introduire dans la macro, la conversion de
décimales, exemple : 22015,95 €, la macro exécute parfaitement la conversion e
lettre pour la première partie mais ne me transforme pas la virgule et le
décimales. du coup je me retrouve qu'avec la première partie en lettre san
plus.

Voici la macro que j'utilise :
Option Explicit
'Main Function
Function SpellNumber(ByVal MyNumber)
Dim Dollars, Cents, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " Mille "
Place(3) = " Million "
Place(4) = " Milliard "
Place(5) = " Trillion "
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, ".")
' Convert cents and set MyNumber to dollar amount.
If DecimalPlace > 0 Then
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
"00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Euros
Case ""
Euros = "No Euros"
Case "One"
Euros = "One Euros"
Case Else
Euros = Euros & " Euros"
End Select
Select Case Cents
Case ""
Cents = " and No Cents"
Case "One"
Cents = " and One Cent"
Case Else
Cents = " and " & Cents & " Cents"
End Select
SpellNumber = Euros & Cents
End Function

' Converts a number from 100-999 into text
Function GetHundreds(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
' Convert the hundreds place.
If Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
End If
' Convert the tens and ones place.
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(MyNumber, 2))
Else
Result = Result & GetDigit(Mid(MyNumber, 3))
End If
GetHundreds = Result
End Function

' Converts a number from 10 to 99 into text.
Function GetTens(TensText)
Dim Result As String
Result = "" ' Null out the temporary function value.
If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
Select Case Val(TensText)
Case 10: Result = "Dix"
Case 11: Result = "Onze"
Case 12: Result = "Douze"
Case 13: Result = "Treize"
Case 14: Result = "Quatorze"
Case 15: Result = "Quinze"
Case 16: Result = "Seize"
Case 17: Result = "Dix-sept"
Case 18: Result = "Dix-huit"
Case 19: Result = "Dix-neuf"
Case Else
End Select
Else ' If value between 20-99...
Select Case Val(Left(TensText, 1))
Case 2: Result = "Vingt"
Case 3: Result = "Trente"
Case 4: Result = "Quarante"
Case 5: Result = "Cinquante"
Case 6: Result = "Soixante"
Case 7: Result = "Soixante-dix"
Case 8: Result = "Quatre-vingts"
Case 9: Result = "Quatre-vingt-dix"
Case Else
End Select
Result = Result & GetDigit _
(Right(TensText, 1)) ' Retrieve ones place.
End If
GetTens = Result
End Function

' Converts a number from 1 to 9 into text.
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "Un"
Case 2: GetDigit = "Deux"
Case 3: GetDigit = "Trois"
Case 4: GetDigit = "Quatre"
Case 5: GetDigit = "Cinq"
Case 6: GetDigit = "Six"
Case 7: GetDigit = "Sept"
Case 8: GetDigit = "Huit"
Case 9: GetDigit = "Neuf"
Case Else: GetDigit = ""
End Select
End Function

Cordialement.
LSteph
2017-02-03 09:59:23 UTC
Réponse
Permalink
Raw Message
bonjour,
J'ai une fonction qui fait çà
je ne sais plus d'où ou de qui je l'avais adaptée qu'il en soit remercié et en conserve tout le mérite...
'LSteph
attention aux retours de ligne:

Function ChiffL(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", "Euro")
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 = "d'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 d'Euro", " centimes d'Euro")
If centime = 0 Then d = "": myct = ""
ChiffL = t & d & myct
End Function

'LSteph
Jacquouille
2017-02-03 10:03:44 UTC
Réponse
Permalink
Raw Message
Salut Stéphane,
In illo tempore, il y avait une page sur Excelabo.net, le site de Misange.
mais, il est désactivé..... -((

Jacques
" Le vin est au repas ce que le parfum est à la femme."
.
"LSteph" a écrit dans le message de groupe de discussion :
5bf89b2f-69b8-45ca-bb54-***@googlegroups.com...

bonjour,
J'ai une fonction qui fait çà
je ne sais plus d'où ou de qui je l'avais adaptée qu'il en soit remercié et
en conserve tout le mérite...
'LSteph
attention aux retours de ligne:

Function ChiffL(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", "Euro")
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 = "d'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 d'Euro", " centimes
d'Euro")
If centime = 0 Then d = "": myct = ""
ChiffL = t & d & myct
End Function

'LSteph


---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus
Jacquouille
2017-02-03 10:02:02 UTC
Réponse
Permalink
Raw Message
Bonjour
Une simple recherche chez mon ami Google donne, en première ligne, ceci:

http://www.chiffreenlettre.com/convertir-chiffre-en-lettre-excel-2010/

Plus vidéo-démo et avec nombres décimaux.

Jacques
" Le vin est au repas ce que le parfum est à la femme."
.
"Serano" a écrit dans le message de groupe de discussion :
***@giganews.com...

Bonjour,

Pourriez vous m'indiquer comment introduire dans la macro, la conversion des
décimales, exemple : 22015,95 €, la macro exécute parfaitement la conversion
en
lettre pour la première partie mais ne me transforme pas la virgule et les
décimales. du coup je me retrouve qu'avec la première partie en lettre sans
plus.

Voici la macro que j'utilise :
Option Explicit
'Main Function
Function SpellNumber(ByVal MyNumber)
Dim Dollars, Cents, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " Mille "
Place(3) = " Million "
Place(4) = " Milliard "
Place(5) = " Trillion "
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, ".")
' Convert cents and set MyNumber to dollar amount.
If DecimalPlace > 0 Then
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
"00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Euros
Case ""
Euros = "No Euros"
Case "One"
Euros = "One Euros"
Case Else
Euros = Euros & " Euros"
End Select
Select Case Cents
Case ""
Cents = " and No Cents"
Case "One"
Cents = " and One Cent"
Case Else
Cents = " and " & Cents & " Cents"
End Select
SpellNumber = Euros & Cents
End Function

' Converts a number from 100-999 into text
Function GetHundreds(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
' Convert the hundreds place.
If Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
End If
' Convert the tens and ones place.
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(MyNumber, 2))
Else
Result = Result & GetDigit(Mid(MyNumber, 3))
End If
GetHundreds = Result
End Function

' Converts a number from 10 to 99 into text.
Function GetTens(TensText)
Dim Result As String
Result = "" ' Null out the temporary function value.
If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
Select Case Val(TensText)
Case 10: Result = "Dix"
Case 11: Result = "Onze"
Case 12: Result = "Douze"
Case 13: Result = "Treize"
Case 14: Result = "Quatorze"
Case 15: Result = "Quinze"
Case 16: Result = "Seize"
Case 17: Result = "Dix-sept"
Case 18: Result = "Dix-huit"
Case 19: Result = "Dix-neuf"
Case Else
End Select
Else ' If value between 20-99...
Select Case Val(Left(TensText, 1))
Case 2: Result = "Vingt"
Case 3: Result = "Trente"
Case 4: Result = "Quarante"
Case 5: Result = "Cinquante"
Case 6: Result = "Soixante"
Case 7: Result = "Soixante-dix"
Case 8: Result = "Quatre-vingts"
Case 9: Result = "Quatre-vingt-dix"
Case Else
End Select
Result = Result & GetDigit _
(Right(TensText, 1)) ' Retrieve ones place.
End If
GetTens = Result
End Function

' Converts a number from 1 to 9 into text.
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "Un"
Case 2: GetDigit = "Deux"
Case 3: GetDigit = "Trois"
Case 4: GetDigit = "Quatre"
Case 5: GetDigit = "Cinq"
Case 6: GetDigit = "Six"
Case 7: GetDigit = "Sept"
Case 8: GetDigit = "Huit"
Case 9: GetDigit = "Neuf"
Case Else: GetDigit = ""
End Select
End Function

Cordialement.


---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus
serano
2017-02-03 14:04:46 UTC
Réponse
Permalink
Raw Message
Post by Serano
Bonjour
http://www.chiffreenlettre.com/convertir-chiffre-en-lettre-excel-2010/
Plus vidéo-démo et avec nombres décimaux.
Jacques
" Le vin est au repas ce que le parfum est à la femme."
.
Bonjour,
Pourriez vous m'indiquer comment introduire dans la macro, la conversion des
décimales, exemple : 22015,95 €, la macro exécute
parfaitement la conversion
en
lettre pour la première partie mais ne me transforme pas la virgule et les
décimales. du coup je me retrouve qu'avec la première partie en lettre sans
plus.
Option Explicit
'Main Function
Function SpellNumber(ByVal MyNumber)
Dim Dollars, Cents, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " Mille "
Place(3) = " Million "
Place(4) = " Milliard "
Place(5) = " Trillion "
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, ".")
' Convert cents and set MyNumber to dollar amount.
If DecimalPlace > 0 Then
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
"00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp <> "" Then Dollars = Temp & Place(Count) &
Dollars
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Euros
Case ""
Euros = "No Euros"
Case "One"
Euros = "One Euros"
Case Else
Euros = Euros & " Euros"
End Select
Select Case Cents
Case ""
Cents = " and No Cents"
Case "One"
Cents = " and One Cent"
Case Else
Cents = " and " & Cents & " Cents"
End Select
SpellNumber = Euros & Cents
End Function
' Converts a number from 100-999 into text
Function GetHundreds(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
' Convert the hundreds place.
If Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
End If
' Convert the tens and ones place.
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(MyNumber, 2))
Else
Result = Result & GetDigit(Mid(MyNumber, 3))
End If
GetHundreds = Result
End Function
' Converts a number from 10 to 99 into text.
Function GetTens(TensText)
Dim Result As String
Result = "" ' Null out the temporary function value.
If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
Select Case Val(TensText)
Case 10: Result = "Dix"
Case 11: Result = "Onze"
Case 12: Result = "Douze"
Case 13: Result = "Treize"
Case 14: Result = "Quatorze"
Case 15: Result = "Quinze"
Case 16: Result = "Seize"
Case 17: Result = "Dix-sept"
Case 18: Result = "Dix-huit"
Case 19: Result = "Dix-neuf"
Case Else
End Select
Else ' If value between 20-99...
Select Case Val(Left(TensText, 1))
Case 2: Result = "Vingt"
Case 3: Result = "Trente"
Case 4: Result = "Quarante"
Case 5: Result = "Cinquante"
Case 6: Result = "Soixante"
Case 7: Result = "Soixante-dix"
Case 8: Result = "Quatre-vingts"
Case 9: Result = "Quatre-vingt-dix"
Case Else
End Select
Result = Result & GetDigit _
(Right(TensText, 1)) ' Retrieve ones place.
End If
GetTens = Result
End Function
' Converts a number from 1 to 9 into text.
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "Un"
Case 2: GetDigit = "Deux"
Case 3: GetDigit = "Trois"
Case 4: GetDigit = "Quatre"
Case 5: GetDigit = "Cinq"
Case 6: GetDigit = "Six"
Case 7: GetDigit = "Sept"
Case 8: GetDigit = "Huit"
Case 9: GetDigit = "Neuf"
Case Else: GetDigit = ""
End Select
End Function
Cordialement.
---
L'absence de virus dans ce courrier électronique a été
vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus
Bonjour,

Serait-il possible d'intégrer les informations manquantes pour faire apparaître
dans la macro que j'ai posté la partie qui manquerait pour permettre de faire
apparaître les sous nombre, je veux dire la virgule et les nombres décimaux, je
possède la version 2007 Excel qui est en mode compatible.

Je me suis rendu sur le site que vous avez joint le lien, mais malheureusement
pour moi, il ne convient que pour les versions ultérieurs à 2007.

Cordialement.
Jacquouille
2017-02-03 15:14:08 UTC
Réponse
Permalink
Raw Message
Bonjour
La fonction MOREFUNC du Grand Chef à 4 plumes (Laurent Longres) fait
parfaitement cela.
ex:
123 = Cent vingt-trois
123 456 789,52 = Cent vingt-trois millions quatre cent cinquante-six mille
sept cent quatre-vingt-neuf, cinquante-deux
Il suffit de télécharger Morefunc (gratuit)
test effectué et réussi sur mon vieux 2003.

Jacques
" Le vin est au repas ce que le parfum est à la femme."
.
Post by Serano
Bonjour
http://www.chiffreenlettre.com/convertir-chiffre-en-lettre-excel-2010/
Plus vidéo-démo et avec nombres décimaux.
Jacques
" Le vin est au repas ce que le parfum est à la femme."
.
Bonjour,
Pourriez vous m'indiquer comment introduire dans la macro, la conversion des
décimales, exemple : 22015,95 €, la macro exécute
parfaitement la conversion
en
lettre pour la première partie mais ne me transforme pas la virgule et les
décimales. du coup je me retrouve qu'avec la première partie en lettre sans
plus.
Option Explicit
'Main Function
Function SpellNumber(ByVal MyNumber)
Dim Dollars, Cents, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " Mille "
Place(3) = " Million "
Place(4) = " Milliard "
Place(5) = " Trillion "
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, ".")
' Convert cents and set MyNumber to dollar amount.
If DecimalPlace > 0 Then
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
"00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp <> "" Then Dollars = Temp & Place(Count) &
Dollars
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Euros
Case ""
Euros = "No Euros"
Case "One"
Euros = "One Euros"
Case Else
Euros = Euros & " Euros"
End Select
Select Case Cents
Case ""
Cents = " and No Cents"
Case "One"
Cents = " and One Cent"
Case Else
Cents = " and " & Cents & " Cents"
End Select
SpellNumber = Euros & Cents
End Function
' Converts a number from 100-999 into text
Function GetHundreds(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
' Convert the hundreds place.
If Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
End If
' Convert the tens and ones place.
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(MyNumber, 2))
Else
Result = Result & GetDigit(Mid(MyNumber, 3))
End If
GetHundreds = Result
End Function
' Converts a number from 10 to 99 into text.
Function GetTens(TensText)
Dim Result As String
Result = "" ' Null out the temporary function value.
If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
Select Case Val(TensText)
Case 10: Result = "Dix"
Case 11: Result = "Onze"
Case 12: Result = "Douze"
Case 13: Result = "Treize"
Case 14: Result = "Quatorze"
Case 15: Result = "Quinze"
Case 16: Result = "Seize"
Case 17: Result = "Dix-sept"
Case 18: Result = "Dix-huit"
Case 19: Result = "Dix-neuf"
Case Else
End Select
Else ' If value between 20-99...
Select Case Val(Left(TensText, 1))
Case 2: Result = "Vingt"
Case 3: Result = "Trente"
Case 4: Result = "Quarante"
Case 5: Result = "Cinquante"
Case 6: Result = "Soixante"
Case 7: Result = "Soixante-dix"
Case 8: Result = "Quatre-vingts"
Case 9: Result = "Quatre-vingt-dix"
Case Else
End Select
Result = Result & GetDigit _
(Right(TensText, 1)) ' Retrieve ones place.
End If
GetTens = Result
End Function
' Converts a number from 1 to 9 into text.
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "Un"
Case 2: GetDigit = "Deux"
Case 3: GetDigit = "Trois"
Case 4: GetDigit = "Quatre"
Case 5: GetDigit = "Cinq"
Case 6: GetDigit = "Six"
Case 7: GetDigit = "Sept"
Case 8: GetDigit = "Huit"
Case 9: GetDigit = "Neuf"
Case Else: GetDigit = ""
End Select
End Function
Cordialement.
---
L'absence de virus dans ce courrier électronique a été
vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus
Bonjour,

Serait-il possible d'intégrer les informations manquantes pour faire
apparaître
dans la macro que j'ai posté la partie qui manquerait pour permettre de
faire
apparaître les sous nombre, je veux dire la virgule et les nombres décimaux,
je
possède la version 2007 Excel qui est en mode compatible.

Je me suis rendu sur le site que vous avez joint le lien, mais
malheureusement
pour moi, il ne convient que pour les versions ultérieurs à 2007.

Cordialement.


---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus
Jacquouille
2017-02-03 15:17:41 UTC
Réponse
Permalink
Raw Message
Avec le sourire de la crémière: -))
Télécharger MOREFUNC (Macro complémentaire EXCEL) (gratuit)
www.commentcamarche.net › Télécharger › Bureautique › Tableur
Note : 4,2 - ‎12 votes - ‎GratuitMorefunc est une macro complémentaire
proposant 67 nouvelles fonctions de feuille de calcul pour Excel. Ces
fonctions sont compatibles avec Excel 95 à 2007 ...
Jacques
" Le vin est au repas ce que le parfum est à la femme."
.
"Jacquouille" a écrit dans le message de groupe de discussion :
o726o0$l13$***@gioia.aioe.org...

Bonjour
La fonction MOREFUNC du Grand Chef à 4 plumes (Laurent Longres) fait
parfaitement cela.
ex:
123 = Cent vingt-trois
123 456 789,52 = Cent vingt-trois millions quatre cent cinquante-six mille
sept cent quatre-vingt-neuf, cinquante-deux
Il suffit de télécharger Morefunc (gratuit)
test effectué et réussi sur mon vieux 2003.

Jacques
" Le vin est au repas ce que le parfum est à la femme."
.
Post by Serano
Bonjour
http://www.chiffreenlettre.com/convertir-chiffre-en-lettre-excel-2010/
Plus vidéo-démo et avec nombres décimaux.
Jacques
" Le vin est au repas ce que le parfum est à la femme."
.
Bonjour,
Pourriez vous m'indiquer comment introduire dans la macro, la conversion des
décimales, exemple : 22015,95 €, la macro exécute
parfaitement la conversion
en
lettre pour la première partie mais ne me transforme pas la virgule et les
décimales. du coup je me retrouve qu'avec la première partie en lettre sans
plus.
Option Explicit
'Main Function
Function SpellNumber(ByVal MyNumber)
Dim Dollars, Cents, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " Mille "
Place(3) = " Million "
Place(4) = " Milliard "
Place(5) = " Trillion "
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, ".")
' Convert cents and set MyNumber to dollar amount.
If DecimalPlace > 0 Then
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
"00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp <> "" Then Dollars = Temp & Place(Count) &
Dollars
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Euros
Case ""
Euros = "No Euros"
Case "One"
Euros = "One Euros"
Case Else
Euros = Euros & " Euros"
End Select
Select Case Cents
Case ""
Cents = " and No Cents"
Case "One"
Cents = " and One Cent"
Case Else
Cents = " and " & Cents & " Cents"
End Select
SpellNumber = Euros & Cents
End Function
' Converts a number from 100-999 into text
Function GetHundreds(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
' Convert the hundreds place.
If Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
End If
' Convert the tens and ones place.
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(MyNumber, 2))
Else
Result = Result & GetDigit(Mid(MyNumber, 3))
End If
GetHundreds = Result
End Function
' Converts a number from 10 to 99 into text.
Function GetTens(TensText)
Dim Result As String
Result = "" ' Null out the temporary function value.
If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
Select Case Val(TensText)
Case 10: Result = "Dix"
Case 11: Result = "Onze"
Case 12: Result = "Douze"
Case 13: Result = "Treize"
Case 14: Result = "Quatorze"
Case 15: Result = "Quinze"
Case 16: Result = "Seize"
Case 17: Result = "Dix-sept"
Case 18: Result = "Dix-huit"
Case 19: Result = "Dix-neuf"
Case Else
End Select
Else ' If value between 20-99...
Select Case Val(Left(TensText, 1))
Case 2: Result = "Vingt"
Case 3: Result = "Trente"
Case 4: Result = "Quarante"
Case 5: Result = "Cinquante"
Case 6: Result = "Soixante"
Case 7: Result = "Soixante-dix"
Case 8: Result = "Quatre-vingts"
Case 9: Result = "Quatre-vingt-dix"
Case Else
End Select
Result = Result & GetDigit _
(Right(TensText, 1)) ' Retrieve ones place.
End If
GetTens = Result
End Function
' Converts a number from 1 to 9 into text.
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "Un"
Case 2: GetDigit = "Deux"
Case 3: GetDigit = "Trois"
Case 4: GetDigit = "Quatre"
Case 5: GetDigit = "Cinq"
Case 6: GetDigit = "Six"
Case 7: GetDigit = "Sept"
Case 8: GetDigit = "Huit"
Case 9: GetDigit = "Neuf"
Case Else: GetDigit = ""
End Select
End Function
Cordialement.
---
L'absence de virus dans ce courrier électronique a été
vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus
Bonjour,

Serait-il possible d'intégrer les informations manquantes pour faire
apparaître
dans la macro que j'ai posté la partie qui manquerait pour permettre de
faire
apparaître les sous nombre, je veux dire la virgule et les nombres décimaux,
je
possède la version 2007 Excel qui est en mode compatible.

Je me suis rendu sur le site que vous avez joint le lien, mais
malheureusement
pour moi, il ne convient que pour les versions ultérieurs à 2007.

Cordialement.


---
L'absence de virus dans ce courrier électronique a été vérifiée par le
logiciel antivirus Avast.
https://www.avast.com/antivirus


---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus
serano
2017-02-03 11:40:34 UTC
Réponse
Permalink
Raw Message
Post by Serano
Bonjour,
Pourriez vous m'indiquer comment introduire dans la macro, la conversion des
décimales, exemple : 22015,95 €, la macro exécute
parfaitement la conversion en lettre pour la première partie mais ne me
transforme pas la virgule et les décimales. du coup je me retrouve
qu'avec la première partie en lettre sans plus.
Option Explicit
'Main Function
Function SpellNumber(ByVal MyNumber)
Dim Dollars, Cents, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " Mille "
Place(3) = " Million "
Place(4) = " Milliard "
Place(5) = " Trillion "
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, ".")
' Convert cents and set MyNumber to dollar amount.
If DecimalPlace > 0 Then
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
"00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp <> "" Then Dollars = Temp & Place(Count)
& Dollars
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Euros
Case ""
Euros = "No Euros"
Case "One"
Euros = "One Euros"
Case Else
Euros = Euros & " Euros"
End Select
Select Case Cents
Case ""
Cents = " and No Cents"
Case "One"
Cents = " and One Cent"
Case Else
Cents = " and " & Cents & " Cents"
End Select
SpellNumber = Euros & Cents
End Function
' Converts a number from 100-999 into text
Function GetHundreds(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
' Convert the hundreds place.
If Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
End If
' Convert the tens and ones place.
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(MyNumber, 2))
Else
Result = Result & GetDigit(Mid(MyNumber, 3))
End If
GetHundreds = Result
End Function
' Converts a number from 10 to 99 into text.
Function GetTens(TensText)
Dim Result As String
Result = "" ' Null out the temporary function value.
If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
Select Case Val(TensText)
Case 10: Result = "Dix"
Case 11: Result = "Onze"
Case 12: Result = "Douze"
Case 13: Result = "Treize"
Case 14: Result = "Quatorze"
Case 15: Result = "Quinze"
Case 16: Result = "Seize"
Case 17: Result = "Dix-sept"
Case 18: Result = "Dix-huit"
Case 19: Result = "Dix-neuf"
Case Else
End Select
Else ' If value between 20-99...
Select Case Val(Left(TensText, 1))
Case 2: Result = "Vingt"
Case 3: Result = "Trente"
Case 4: Result = "Quarante"
Case 5: Result = "Cinquante"
Case 6: Result = "Soixante"
Case 7: Result = "Soixante-dix"
Case 8: Result = "Quatre-vingts"
Case 9: Result = "Quatre-vingt-dix"
Case Else
End Select
Result = Result & GetDigit _
(Right(TensText, 1)) ' Retrieve ones place.
End If
GetTens = Result
End Function
' Converts a number from 1 to 9 into text.
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "Un"
Case 2: GetDigit = "Deux"
Case 3: GetDigit = "Trois"
Case 4: GetDigit = "Quatre"
Case 5: GetDigit = "Cinq"
Case 6: GetDigit = "Six"
Case 7: GetDigit = "Sept"
Case 8: GetDigit = "Huit"
Case 9: GetDigit = "Neuf"
Case Else: GetDigit = ""
End Select
End Function
Cordialement.
Re bonjour,

Dois-je faire un copié collé si oui à quel niveau je dois la coller, sinon
est-il possible de rajouter sur la macro que je remets ci-dessous, en vous
remerciant d'avance.

Option Explicit
'Main Function
Function SpellNumber(ByVal MyNumber)
Dim Dollars, Cents, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " Mille "
Place(3) = " Million "
Place(4) = " Milliard "
Place(5) = " Trillion "
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, ".")
' Convert cents and set MyNumber to dollar amount.
If DecimalPlace > 0 Then
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
"00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Euros
Case ""
Euros = "No Euros"
Case "One"
Euros = "One Euros"
Case Else
Euros = Euros & " Euros"
End Select
Select Case Cents
Case ""
Cents = " and No Cents"
Case "One"
Cents = " and One Cent"
Case Else
Cents = " and " & Cents & " Cents"
End Select
SpellNumber = Euros & Cents
End Function
' Converts a number from 100-999 into text
Function GetHundreds(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
' Convert the hundreds place.
If Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
End If
' Convert the tens and ones place.
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(MyNumber, 2))
Else
Result = Result & GetDigit(Mid(MyNumber, 3))
End If
GetHundreds = Result
End Function
' Converts a number from 10 to 99 into text.
Function GetTens(TensText)
Dim Result As String
Result = "" ' Null out the temporary function value.
If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
Select Case Val(TensText)
Case 10: Result = "Dix"
Case 11: Result = "Onze"
Case 12: Result = "Douze"
Case 13: Result = "Treize"
Case 14: Result = "Quatorze"
Case 15: Result = "Quinze"
Case 16: Result = "Seize"
Case 17: Result = "Dix-sept"
Case 18: Result = "Dix-huit"
Case 19: Result = "Dix-neuf"
Case Else
End Select
Else ' If value between 20-99...
Select Case Val(Left(TensText, 1))
Case 2: Result = "Vingt"
Case 3: Result = "Trente"
Case 4: Result = "Quarante"
Case 5: Result = "Cinquante"
Case 6: Result = "Soixante"
Case 7: Result = "Soixante-dix"
Case 8: Result = "Quatre-vingts"
Case 9: Result = "Quatre-vingt-dix"
Case Else
End Select
Result = Result & GetDigit _
(Right(TensText, 1)) ' Retrieve ones place.
End If
GetTens = Result
End Function
' Converts a number from 1 to 9 into text.
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "Un"
Case 2: GetDigit = "Deux"
Case 3: GetDigit = "Trois"
Case 4: GetDigit = "Quatre"
Case 5: GetDigit = "Cinq"
Case 6: GetDigit = "Six"
Case 7: GetDigit = "Sept"
Case 8: GetDigit = "Huit"
Case 9: GetDigit = "Neuf"
Case Else: GetDigit = ""
End Select
End Function
MichD
2017-02-04 11:36:46 UTC
Réponse
Permalink
Raw Message
Bonjour,

Tu peux utiliser la nomination canadienne, française et même en anglais!

Un fichier exemple : http://www.cjoint.com/c/GBelIVVDrMi

MichD
Jacquouille
2017-02-04 12:34:16 UTC
Réponse
Permalink
Raw Message
Salut Denis,

Utilisez-vous le septante, ou préférez-vous le 60-10 ?
Au passage, c'est le octante suisse qui me plait bien.... ( macro de LL)
Bonne journée.

Jacques
" Le vin est au repas ce que le parfum est à la femme."
.
"MichD" a écrit dans le message de groupe de discussion :
o74ecj$1rar$***@gioia.aioe.org...

Bonjour,

Tu peux utiliser la nomination canadienne, française et même en anglais!

Un fichier exemple : http://www.cjoint.com/c/GBelIVVDrMi

MichD


---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus
MichD
2017-02-04 20:03:39 UTC
Réponse
Permalink
Raw Message
Que puis-je répondre si je ne comprends pas le commentaire?
;-)

MichD

Loading...