Conversion Nombre en Lettre [Résolu/Fermé]

Signaler
Messages postés
611
Date d'inscription
lundi 29 décembre 2014
Statut
Membre
Dernière intervention
17 janvier 2020
-
Messages postés
15349
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
22 septembre 2020
-
Bjr mes amis,
je demande votre aide concerenant une macro de conversion, Nombre en lettre, on ajoutant "convertible" à la fin de la conversion.

exemple:
si je met 3 : la conversion sera: tois euros convertibles
et si je met: 3.5 euro: la conversion sera: trois euros et cinq centimes convertibles

la macro est automatique exécutable sur une seule cellule.

Merci infiniment mes amis

4 réponses

Messages postés
15349
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
22 septembre 2020
1 360
1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 61014 internautes nous ont dit merci ce mois-ci

Messages postés
15349
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
22 septembre 2020
1 360 >
Messages postés
611
Date d'inscription
lundi 29 décembre 2014
Statut
Membre
Dernière intervention
17 janvier 2020

Re,
Dans la fonction choixlangue enlevez convertible à toutes les lignes
Dans finition convtexte, à la fin:
Convtexte=ltrim(rtrim(Convtexte)) & " Convertible"
Simple, non!
Messages postés
611
Date d'inscription
lundi 29 décembre 2014
Statut
Membre
Dernière intervention
17 janvier 2020

Bjr mr f894009, je dois ajouter: Convtexte=ltrim(rtrim(Convtexte)) & " Convertible"
a la fin ?? ou exactement?
Messages postés
15349
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
22 septembre 2020
1 360 >
Messages postés
611
Date d'inscription
lundi 29 décembre 2014
Statut
Membre
Dernière intervention
17 janvier 2020

Bonjour,

je dois ajouter:
Non remplacer
Convtexte=ltrim(rtrim(Convtexte))

par
Convtexte=ltrim(rtrim(Convtexte)) & " Convertible"
Messages postés
611
Date d'inscription
lundi 29 décembre 2014
Statut
Membre
Dernière intervention
17 janvier 2020

mais ça changé rien maintenant je ne reçois plus "convertibles" ni quand je met le chiffre 3 tout seul, et lorsque je met 3.2.
NB: j'ai supprimé tous les convertibes dans le model et j'ai fait le remplacement.
Messages postés
15349
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
22 septembre 2020
1 360 >
Messages postés
611
Date d'inscription
lundi 29 décembre 2014
Statut
Membre
Dernière intervention
17 janvier 2020

Re,
Autant pour moi, me suis trompe de function
votre fichier modifie: https://www.cjoint.com/c/GBCm7TODRif
Messages postés
14771
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
21 septembre 2020
577
Bonsoir

je propose ici un code général (sans l'histoire du convertible à ajouter) en VB.Net (pour l'instant)
Messages postés
15349
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
22 septembre 2020
1 360 >
Messages postés
12185
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
21 septembre 2020

Bonjour,

Tout a fait Thierry. C'est pour cela que j'ai demande a Whismeril:, dans quel cas y a pas de tableau, car dans son code il redim les deux tableaux utilises en debut d'excution et en testant son code, je n'ai jamais eu d'erreur
Messages postés
12185
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
21 septembre 2020
2 478 >
Messages postés
15349
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
22 septembre 2020

Exact f89..., ces deux lignes se suffisent :
    ReDim resultat(0)
    ReDim troisChiffres(0)

Mais donc, Whis, à mon sens plus besoin de IsArray...
Ceci doit fonctionner :
Sub AjouteResultat(ByVal Texte As String) 
    ReDim Preserve resultat(UBound(resultat) + 1)
    resultat(UBound(resultat) - 1) = Texte
End Sub

Mais comme dit précédemment, je n'ai pas encore eu le temps de tester ton code...
Messages postés
15349
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
22 septembre 2020
1 360 >
Messages postés
12185
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
21 septembre 2020

Re,

Boh Oui! (David)
Messages postés
12185
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
21 septembre 2020
2 478 >
Messages postés
14771
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
21 septembre 2020

Bon.
Après tests...
1- il subsiste un espace en fin de chaine.
Donc : utiliser Trim après l'affectation du résultat
    ToLettres = Join(resultat, " ")
    ToLettres = Trim(ToLettres)


2- Ceci fonctionne :
'Ajoute une valeur au tableau
Sub AjouteResultat(ByVal Texte As String)
    ReDim Preserve resultat(UBound(resultat) + 1)
    resultat(UBound(resultat) - 1) = Texte
End Sub


3- laisser la possibilité d'une majuscule en premier caractère (i.e : Deux cent) soit :
> en ajoutant un paramètre optional
> en précisant d'utiliser la fonction de feuille =NOMPROPRE(ToLettres(123,465))

4- pour un "débutant", les enum risquent de poser problème pour une fonction dans la feuille de calcul. Donc bien préciser dans les paramètres :
'<param>
'Nombre est le nombre à écrire
'LePays est le pays d'utilisation, pour spécificités régionales
    'valeurs possibles :
        'France = 0
        'Belgique = 1
        'Suisse = 2
'LaDevise la devise à utliser le cas échéant
    'valeurs possibles :
        'Aucune = 0
        'Euro = 1
        'FrancSuisse = 2
        'Dollar = 3
'</param>


Sinon, très joli travail, propre, soigné, efficace, utile, juste.
What Else?
Messages postés
15349
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
22 septembre 2020
1 360 >
Messages postés
12185
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
21 septembre 2020

Re,

Oui, merci a lui
'un des cas ou IsArray est utile
Sub Choix_fichiers()
    'selction multiple ou un seul fichier
    FichiersAOuvrir = Application.GetOpenFilename("Excel Files (*.xls),*.xls", , "SELECTION FICHIER(S) TEST", , True)
        If IsArray(FichiersAOuvrir) Then    'test si pas annuler ou pas croix fermeture boite dial
            'code
        End If
End Sub
Messages postés
15349
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
22 septembre 2020
1 360
Re,

Whismeril:

OK, ca roule et encore merci pour ce code
Messages postés
14771
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
21 septembre 2020
577
Bonsoir

suite à une remarque sur un code JS similaire, voici une correction
Option Explicit
Option Base 0

Public Enum Pays
    France
    Belgique
    Suisse
End Enum

Public Enum Devise
    Aucune
    Euro
    FrancSuisse
    Dollar
End Enum

Dim jusqueSeize As Variant

Dim dizaines As Variant

Dim resultat() As String

Dim troisChiffres() As Integer 'tableau qui scinde la partie entière en morceaux de 3 chiffres



'Fonction écrivant le nombre en lettres
'Nombre est le nombre à écrire
'LePays est le pays d'utilisation, pour spécificitées régionnales. Il s'agit d'un énumérable définit plus haut, les valeurs possiblis sont:
' France ou 0
' Belgique ou 1
' Suisse ou 2
'LaDevise la devise à utliser le cas échéant. Les valeurs possibles sont:
' Aucune ou 0
' Euro ou 1
' FrancSuisse ou 2
' Dollar ou 3
Public Function ToLettres(ByVal Nombre As Double, Optional ByVal LePays As Pays = Pays.France, Optional ByVal LaDevise As Devise = Devise.Aucune) As String

    ReDim resultat(0)
    ReDim troisChiffres(0)
    
    Select Case Sgn(Nombre)
        Case -1
            AjouteResultat "moins "
            Nombre = Nombre * -1

        Case 0
            ToLettres = jusqueSeize(0)
            Exit Function

    End Select
    
    If Nombre >= 2147483647 Then 'j'utilise un long pour la partie entière et c'est la valeur maximun
        ToLettres = "Nombre trop grand"
        Exit Function
    End If

    jusqueSeize = Array("zéro", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize")
    dizaines = Array("rien", "dix", "vingt", "trente", "quarante", "cinquante", "soixante", "soixante", "quatre-vingt", "quatre-vingt")


    Dim PartieEntiere As Long
    PartieEntiere = CLng(Fix(Nombre))
    
    Dim partieDecimale As Double
    partieDecimale = Nombre - PartieEntiere

    Dim milliers As Variant
    milliers = Array("", "mille", "million", "milliard", "billion", "billiard")

    If PartieEntiere > 0 Then

        Do While PartieEntiere > 0
            AjouteTroisChiffres CInt(Fix(PartieEntiere Mod 1000))
            PartieEntiere = PartieEntiere \ 1000
        Loop

        Dim reste As Double
        reste = Nombre - PartieEntiere


        Dim i As Integer

        For i = UBound(troisChiffres) - 1 To 0 Step -1
            Dim leNombre As Integer
            leNombre = troisChiffres(i)

            If leNombre > 1 Then 'valeurs de milliers au pluriel
                AjouteResultat Ecrit3Chiffres(troisChiffres(i), LePays, i = 0) 'pour 400 000, cent ne prend pas de S alors que pour 400 si
                If i > 1 Then ' mille est invariable et "" ne prend pas de s
                    AjouteResultat milliers(i) & "s"
                ElseIf i = 1 Then
                    AjouteResultat milliers(i)
                End If
            ElseIf leNombre = 1 Then
                If i <> 1 Then 'on dit un million, mais pas un mille
                    AjouteResultat "un"
                End If
                AjouteResultat milliers(i)
            End If
            'on ne traite pas le 0, car on ne dit pas X millions zéro mille Y.
        Next i
    Else
        AjouteResultat jusqueSeize(0)
    End If

    Select Case LaDevise
        Case Devise.Dollar
            AjouteResultat "$"

        Case Devise.Euro
            AjouteResultat "€"

        Case Devise.FrancSuisse
            AjouteResultat "CHF"

    End Select

    If LaDevise <> Devise.Aucune Then
        partieDecimale = Round(partieDecimale, 2)
        If partieDecimale <> 0 Then
            AjouteResultat "et"
            AjouteResultat Ecrire2Chiffres(CInt(Fix(partieDecimale * 100)), LePays)
            AjouteResultat "centimes"
        End If
    Else
        milliers = Array("millième", "millionième", "milliardième")

        'avec l'imprécision des nombres à virgules flotantes,  1234562.789 - 1234562 donne 0.78900000010617077 il faut donc compter le nombre de chiffres décimaux du nombre original et arrondir le resultat de la soustraction
        Dim morceaux() As String
        morceaux = Split(CStr(Nombre), ",") 'par défaut ToString arrondi à 10^-8, le format G25 oblige à écrire 25 caractères s'ils sont présents soit (au pire) 15 avant la virgule, la virgule et 9 après, split permet de découper le string obtenu

        If UBound(morceaux) = 1 Then 'il y a une partie décimale
            AjouteResultat "et"

            Dim lenghtPartieDecimale As Integer
            lenghtPartieDecimale = Len(morceaux(1))
            
            If lenghtPartieDecimale > 9 Then
                lenghtPartieDecimale = 9 'on se limite à 10^-9
            End If

            partieDecimale = Round(partieDecimale, lenghtPartieDecimale)

            i = 0
            Do While partieDecimale > 0
                partieDecimale = partieDecimale * 1000
                Dim valeur As Integer
                valeur = CInt(Fix(partieDecimale))
                lenghtPartieDecimale = lenghtPartieDecimale - 3
                If lenghtPartieDecimale < 0 Then
                    lenghtPartieDecimale = 0
                End If
                partieDecimale = Round(partieDecimale - valeur, lenghtPartieDecimale)

                If valeur <> 0 Then
                    AjouteResultat Ecrit3Chiffres(valeur, LePays, False) '0.400 cent ne prend pas d's car il y a millième après
                    If valeur > 1 Then
                        AjouteResultat milliers(i) & "s"
                        i = i + 1
                    Else
                        AjouteResultat milliers(i)
                        i = i + 1
                    End If

                End If
            Loop


        End If
    End If



    ToLettres = Trim(Join(resultat, " "))
End Function

'Ecrit les nombres de 0 à 999
Private Function Ecrit3Chiffres(ByVal Nombre As Integer, ByVal LePays As Pays, RegleDuCent As Boolean) As String
    If Nombre = 100 Then
        Ecrit3Chiffres = "cent"
        Exit Function
    End If

    If Nombre < 100 Then
        Ecrit3Chiffres = Ecrire2Chiffres(Nombre, LePays)
        Exit Function
    End If

    Dim centaine As Integer
    centaine = Nombre \ 100
    Dim reste As Integer
    reste = Nombre Mod 100

    If reste = 0 Then 'Cent prend un s quand il est multiplié et non suivi d'un mot, comme le cas de 100 est déjà traité on est face à un multiple
        If RegleDuCent = True Then
            Ecrit3Chiffres = jusqueSeize(centaine) & " cents"
        Else 'pour 400 000 par exemple cent ne prend pas le s
            Ecrit3Chiffres = jusqueSeize(centaine) & " cent"
        End If
        Exit Function
    End If

    If centaine = 1 Then
        Ecrit3Chiffres = "cent " & Ecrire2Chiffres(reste, LePays) 'on ne dit pas un cent X, mais cent X
        Exit Function
    End If

    Ecrit3Chiffres = jusqueSeize(centaine) & " cent " & Ecrire2Chiffres(reste, LePays)
End Function

'Ecrit les nombres de 0 à 99
Private Function Ecrire2Chiffres(ByVal Nombre As Integer, ByVal LePays As Pays) As String
    If LePays <> Pays.France Then
        dizaines(7) = "septante"
        dizaines(9) = "nonante"
    End If
    If LePays = Pays.Suisse Then
        dizaines(8) = "huitante"
    End If

    If Nombre < 17 Then
        Ecrire2Chiffres = jusqueSeize(Nombre)
        Exit Function
    End If

    Select Case Nombre 'cas particuliers de 71, 80 et 81
        Case 71 'en France 71 prend un et
            If LePays = Pays.France Then
                Ecrire2Chiffres = "soixante et onze"
                Exit Function
            End If

        Case 80 'en France et Belgique le vingt prend un s
            If LePays = Pays.Suisse Then
                Ecrire2Chiffres = dizaines(8)
                Exit Function
            Else
                Ecrire2Chiffres = dizaines(8) & "s"
                Exit Function
            End If

        Case 81 'en France et Belgique il n'y a pas de et
            If LePays <> Pays.Suisse Then
                Ecrire2Chiffres = dizaines(8) & "-un"
                Exit Function
            End If
    End Select


    Dim dizaine As Integer
    dizaine = Nombre \ 10
    Dim unite As Integer
    unite = Nombre Mod 10

    Dim laDizaine As String
    laDizaine = dizaines(dizaine)

    If LePays = France And (dizaine = 7 Or dizaine = 9) Then
        dizaine = dizaine - 1
        unite = unite + 10
    End If


    Select Case unite
        Case 0
            Ecrire2Chiffres = laDizaine

        Case 1
            Ecrire2Chiffres = laDizaine & " et un"

        Case 17, 18, 19 'pour 77 à 79 et 97 à 99
            unite = unite Mod 10
            Ecrire2Chiffres = laDizaine & "-dix-" & jusqueSeize(unite)

        Case Else
            Ecrire2Chiffres = laDizaine & "-" & jusqueSeize(unite)
    End Select
End Function

'Ajoute une valeur au tableau
Sub AjouteResultat(ByVal Texte As String)
    If IsArray(resultat) Then
        Dim taille As Integer
        taille = UBound(resultat) + 1
    Else
        taille = 1
    End If
    
    ReDim Preserve resultat(taille)
    resultat(taille - 1) = Texte
End Sub

'ajoute une valeur au tableau
Sub AjouteTroisChiffres(ByVal Entier As Integer)
    If IsArray(troisChiffres) Then
        Dim taille As Integer
        taille = UBound(troisChiffres) + 1
    Else
        taille = 1
    End If
    
    ReDim Preserve troisChiffres(taille)
    troisChiffres(taille - 1) = Entier
End Sub


'code de test
Sub test()
        ActiveSheet.Range("A1") = ToLettres(123.456)
        ActiveSheet.Range("A2") = ToLettres(3210987654321.2)
        ActiveSheet.Range("A3") = ToLettres(123456789012345#)
        ActiveSheet.Range("A4") = ToLettres(1234.123456789)
        ActiveSheet.Range("A5") = ToLettres(-4321.987654321)
        ActiveSheet.Range("A6") = ToLettres(1E+16)    'ce nombre est trop grand
        ActiveSheet.Range("A7") = ToLettres(0.12345678961)  'il y a trop de chiffres dérrière la virgule, le resultat sera arrondi
        ActiveSheet.Range("A8") = ToLettres(6795432.456, Belgique, Euro) 'pour les options, on peut mettre les "mots clés"
        ActiveSheet.Range("A9") = ToLettres(400400400, 0, 0) 'pour les options, on peut mettre les chiffres correspondants aux "mots clés"
        ActiveSheet.Range("A10") = ToLettres(0.4)
        
End Sub

Quand j'étais petit, la mer Morte n'était que malade.
George Burns
Messages postés
14771
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
21 septembre 2020
577
Messages postés
15349
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
22 septembre 2020
1 360 >
Messages postés
14771
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
21 septembre 2020