XL 2013 Convertir chiffres en lettres en anglais avec 3 nombre après virgule

G

Galaxy_2019

XLDnaute Junior
Bonjour le Forum,

Vue que je suis nul en VBA, je me suis coincé et j'ai pas trouvé une solution adéquate sur le Net.

Mon besoin c'est de trouvé un code VBA qui convertir les chiffres en lettres en anglais avec 3 chiffres après la virgule et selon le devise aux choix.

J'ai trouvé un fichier (en pièce jointe) qui convertir les chiffres en lettres en français mais j'ai pas pu l'adapté.

Merci infiniment

Dans l'attente de votre réponses.

Cordialement
 

Pièces jointes

  • Test.xlsm
    30.7 KB · Affichages: 37
Dernière édition:
Trier par date Trier par votes
cp4

cp4

XLDnaute Barbatruc
Galaxy_2019 à dit:
Bonjour,

les trois chiffres sont exprimés en "Fils"(Dinar Kuwaiti)
12,365 ------>Twelve Dinars and Three hundred and sixty five Fils

Cordialement
Cliquez pour agrandir...
@Galaxy_2019 : J'ai pu te trouver le code ci-joint mais en Français et pour des dinars Tunisiens.
Je te laisse remplacé les chiffres en anglais et millimes pas Fils. J'espère que ça répond bien à tes attentes. Il faut mettre les mains dans le cambouis:p.
Bon courage
 

Pièces jointes

  • NbreLettres.docx
    185.8 KB · Affichages: 11
Vote positif 0 Vote négatif
cp4

cp4

XLDnaute Barbatruc
Bonjour,
Apparemment, tu n'aimes pas te salir les mains. Mais là, il n'est pas question de se salir.
Il fallait juste faire un effort de compréhension du code.
ci-joint code modifié pour Dinar Kowetien (voir Tunisien comme précisé par PatrickToulon;), en modifiant Fils par Millime).
VB: 
Option Explicit

Function SpellDinarKuwaiti(ByVal MyNumber)
   Dim Dinars, Fils, Temp, DecimalPlace, Count
   ReDim Place(9) As String
   Place(2) = " Thousand "
   Place(3) = " Million "
   Place(4) = " Billion "
   Place(5) = " Trillion "

   ' String representation of amount.
   MyNumber = Trim(Str(MyNumber))

   ' Position of decimal place 0 if none.
   DecimalPlace = InStr(MyNumber, ".")
   ' Convert Fils and set MyNumber to dollar amount.
   If DecimalPlace > 0 Then
      Fils = GetHundreds(Left(Mid(MyNumber, DecimalPlace + 1) & "000", 3))
      MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
   End If

   Count = 1
   Do While MyNumber <> ""
      Temp = GetHundreds(Right(MyNumber, 3))
      If Temp <> "" Then Dinars = Temp & Place(Count) & Dinars
      If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 4)
      Else
         MyNumber = ""
      End If
      Count = Count + 1
   Loop

   Select Case Dinars
   Case ""
      Dinars = "No Dinars"
   Case "One"
      Dinars = "One Dollar"
   Case Else
      Dinars = Dinars & " Dinars"
   End Select

   Select Case Fils
   Case ""
      Fils = " and No Fils"
   Case "One"
      Fils = " and One Cent"
   Case Else
      Fils = " and " & Fils & " Fils"
   End Select

   SpellDinarKuwaiti = Dinars & Fils
Debug.Print "SpellDinarKuwaiti =" & SpellDinarKuwaiti
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)
Debug.Print MyNumber
   ' 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
Debug.Print "Left(TensText, 1):" & Left(TensText, 1)
   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 = "Ten"
      Case 11: Result = "Eleven"
      Case 12: Result = "Twelve"
      Case 13: Result = "Thirteen"
      Case 14: Result = "Fourteen"
      Case 15: Result = "Fifteen"
      Case 16: Result = "Sixteen"
      Case 17: Result = "Seventeen"
      Case 18: Result = "Eighteen"
      Case 19: Result = "Nineteen"
      Case Else
      End Select

   Else                                 ' If value between 20-99...

      Select Case Val(Left(TensText, 1))
      Case 2: Result = "Twenty "
      Case 3: Result = "Thirty "
      Case 4: Result = "Forty "
      Case 5: Result = "Fifty "
      Case 6: Result = "Sixty "
      Case 7: Result = "Seventy "
      Case 8: Result = "Eighty "
      Case 9: Result = "Ninety "
      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 = "One"
   Case 2: GetDigit = "Two"
   Case 3: GetDigit = "Three"
   Case 4: GetDigit = "Four"
   Case 5: GetDigit = "Five"
   Case 6: GetDigit = "Six"
   Case 7: GetDigit = "Seven"
   Case 8: GetDigit = "Eight"
   Case 9: GetDigit = "Nine"
   Case Else: GetDigit = ""
   End Select
End Function
Bonne journée.
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
@cp4
pas de bras pas de chocolat ;)
Vecteurs pour Smiley déçu, Illustrations libres de droits pour Smiley déçu | Depositphotos®
 
Vote positif 0 Vote négatif
G

Galaxy_2019

XLDnaute Junior
cp4 à dit:
@Galaxy_2019 : J'ai pu te trouver le code ci-joint mais en Français et pour des dinars Tunisiens.
Je te laisse remplacé les chiffres en anglais et millimes pas Fils. J'espère que ça répond bien à tes attentes. Il faut mettre les mains dans le cambouis:p.
Bon courage
Cliquez pour agrandir...


Bonjour cp4, patricktoulon, et le Forum,

Désolé pour le retard

@cp4: j'ai déjà essayé de modifier le code selon la monnaies, mais je me suis coincé quant à les 3 chiffres après la virgule.

Merci pour votre code en poste #17, je vais le testé, et te reviendra, merci beaucoup cp4

Merci à vous
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
@cp4 si tu va bien chercher c'est beaucoup plus simple que ça
en fait tu a un nombre décimal ou pas
comment disséquer les tranches
ben par exemple
VB: 
Sub test()
    nbletterUS 13521.57
End Sub

Function nbletterUS(nombre As String)    '!!!!as string!!!!!!'3 ficche apres la virgule meme si il n'y sont pas dans le nombre
    ul = Array("", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine", "Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", "Eighteen", "Nineteen")
    diz = Array("", "", "Twenty ", "Thirty ", "Forty ", "Fifty ", "Sixty ", "Seventy ", "Eighty ", "Ninety ")

    t = Split(nombre, ",")
    For i = 0 To UBound(t)
        If i = 0 Then
            Z = Split(Trim(Format(t(0), Application.Rept(" @@@", Len(t(0) / 3) + 1))), " ")
        Else
            Z = Array(Left(t(1) & "00", 3))
        End If
        For p = 0 To UBound(Z)
            c = "": d = "": u = ""

            If Z(p) > 99 Then c = IIf(Left(Z(p), 1) > 1, ul(Left(Z(p), 1)) & " hundred", " hundred") Else c = ""
            dx = Val(Right(Z(p), 2))
            If dx < 20 Then d = "": u = ul(Right(dx, 2))
            If dx > 20 Then d = diz(Left(dx, 1)): u = ul(Right(dx, 1))

            Debug.Print Z(p) & ": " & c & " " & d & u
        Next
Debug.Print "--------------"
    Next
End Function
en US c'est hyper simple en fait
 
Vote positif 0 Vote négatif
cp4

cp4

XLDnaute Barbatruc
patricktoulon à dit:
re
@cp4 si tu va bien chercher c'est beaucoup plus simple que ça
en fait tu a un nombre décimal ou pas
comment disséquer les tranches
ben par exemple
VB: 
Sub test()
    nbletterUS 13521.57
End Sub

Function nbletterUS(nombre As String)    '!!!!as string!!!!!!'3 ficche apres la virgule meme si il n'y sont pas dans le nombre
    ul = Array("", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine", "Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", "Eighteen", "Nineteen")
    diz = Array("", "", "Twenty ", "Thirty ", "Forty ", "Fifty ", "Sixty ", "Seventy ", "Eighty ", "Ninety ")

    t = Split(nombre, ",")
    For i = 0 To UBound(t)
        If i = 0 Then
            Z = Split(Trim(Format(t(0), Application.Rept(" @@@", Len(t(0) / 3) + 1))), " ")
        Else
            Z = Array(Left(t(1) & "00", 3))
        End If
        For p = 0 To UBound(Z)
            c = "": d = "": u = ""

            If Z(p) > 99 Then c = IIf(Left(Z(p), 1) > 1, ul(Left(Z(p), 1)) & " hundred", " hundred") Else c = ""
            dx = Val(Right(Z(p), 2))
            If dx < 20 Then d = "": u = ul(Right(dx, 2))
            If dx > 20 Then d = diz(Left(dx, 1)): u = ul(Right(dx, 1))

            Debug.Print Z(p) & ": " & c & " " & d & u
        Next
Debug.Print "--------------"
    Next
End Function
en US c'est hyper simple en fait
Cliquez pour agrandir...
@patricktoulon ;): Merci beaucoup, J'essaie d'apprendre et me perfectionner.
J'ai donc essayé de comprendre le code mis en ligne pas kiki29.
Si J'ai réussi à l'adapter pour qu'il prenne en charge les millimes. J'avoue ne pas avoir tout compris.
En effet, dans code initial (en dollar) par exemple la ligne ci-dessous:
VB: 
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
'pourquoi la concatenation avec "00"' car la ligne ci-dessous renvoie la même 
'chaine (les 2 chiffres après la virgule)
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) , 2))
Je vais prendre le temps d'étudier ton code.
Merci bonne soirée.
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
bonjour pour le coup j'ai revu ma fonction nblettreFR
j'ai entièrement reconstruit le moteur différemment
et j'ai intégré
le sans monnaie (3 chiffres après la virgule)
avec monnaie euro,dollar (2 chiffres après la virgule)
avec monnaie dinar,dinar k,(3 chiffres après la virgule centimes fil/millime)
on pourra ajouter une monnaie dans le select case fric avec ses paramètres

bientôt dispo dans la ressource (je met ça au propre)
je ferais la version anglais avec un moteur similaire
 
Vote positif 0 Vote négatif
cp4

cp4

XLDnaute Barbatruc
patricktoulon à dit:
re
bonjour pour le coup j'ai revu ma fonction nblettreFR
j'ai entièrement reconstruit le moteur différemment
et j'ai intégré
le sans monnaie (3 chiffres après la virgule)
avec monnaie euro,dollar (2 chiffres après la virgule)
avec monnaie dinar,dinar k,(3 chiffres après la virgule centimes fil/millime)
on pourra ajouter une monnaie dans le select case fric avec ses paramètres

bientôt dispo dans la ressource (je met ça au propre)
je ferais la version anglais avec un moteur similaire
Cliquez pour agrandir...
Bonjour PatrickToulon "le vaillant":cool: ;),
Merci pour ta disponibilité et ton dévouement pour cette communauté.
Merci de m'envoyer un petit message lorsque ça sera au point.

Bonne journée.
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Résolu(e)
Microsoft 365 VBA pour transformer une plage en tableau + Générer un tableau de synthèse
Réponses
10
Affichages
334
Merlin258413
M
D
  • Question
Autres MFC si 3 chiffres après la virgule
2
Réponses
17
Affichages
2 K
job75
job75
G
  • Question
XL 2013 Conversion chiffres en lettre avec 3 chiffre après la virgule
Réponses
5
Affichages
2 K
patricktoulon
patricktoulon
Magic_Doctor
  • Question
XL 2010 Comparer le nombre de décimales après la virgule d’une série de chiffres
2
Réponses
20
Affichages
3 K
Dranreb
Dranreb
A
  • Question
XL 2019 Convertir des chiffres en lettres
2 3 4
Réponses
47
Affichages
41 K
patricktoulon
patricktoulon
S
  • Résolu(e)
XL 2016 Séparateurs décimales & milliers sur un import csv
2
Réponses
18
Affichages
2 K
sabrina_
S
S
  • Question
Microsoft 365 Concatener données en double dans une même ligne (sans et avec VBA)
Réponses
5
Affichages
1 K
chris
chris
D
  • Résolu(e)
Microsoft 365 Addition des nombres dans une cellule avec du texte
2 3 4
Réponses
57
Affichages
4 K
Staple1600
Staple1600
S
  • Question
XL 2010 VBA - macro avec 1 boucle qui alterne 1 action à conditions et 1 action sans conditions
2 3 4
Réponses
58
Affichages
6 K
Scorp0211
S
philsogood
  • Question
Microsoft 365 enregistrer format CSV avec virgule
Réponses
4
Affichages
6 K
Staple1600
Staple1600

Membres actuellement en ligne

1 membres et 68 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 196
Messages
2 086 101
Membres
103 116
dernier inscrit
kutobi87