IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Contribuez Discussion :

chiffres en lettres vraie fonction


Sujet :

Contribuez

  1. #1
    Expert éminent Avatar de casefayere
    Homme Profil pro
    RETRAITE
    Inscrit en
    Décembre 2006
    Messages
    5 138
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 69
    Localisation : France, Ardennes (Champagne Ardenne)

    Informations professionnelles :
    Activité : RETRAITE
    Secteur : Agroalimentaire - Agriculture

    Informations forums :
    Inscription : Décembre 2006
    Messages : 5 138
    Points : 9 548
    Points
    9 548
    Par défaut chiffres en lettres vraie fonction
    Bonjour,
    j'ai remodelé mon fichier pour en faire une vrai fonction personnalisée et en corrigeant certains détails

    Merci de vos remarques éventuelles
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
     
    Function LITTERAL(Nombre As Currency, Unite As String)
    Dim Mcent(99), McentE, Cent, CentE, i As Integer, x As Integer
    Dim dec As Boolean, Chiffre As Currency, Avirg As Currency
    If Nombre = 0 Then LITTERAL = "zero": Exit Function
    dec = False
    Chiffre = Nombre
    Nombre = Int(Chiffre)
    Avirg = Round(Chiffre - Nombre, 2)
    If Avirg <> 0 Then Avirg = Split(Avirg, ",")(1): dec = True
    If Unite = "" Then Unite = "et"
    For x = 0 To 99
      Mcent(x) = x
    Next x
    McentE = 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 Vingt", "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")
    Cent = Array(100, 200, 300, 400, 500, 600, 700, 800, 900)
    CentE = Array("", "Cent", "Deux Cent", "Trois Cent", "Quatre Cent", "Cinq Cent", "Six Cent", "Sept Cent", "Huit Cent", "Neuf Cent")
     
    If Nombre < 100 Then LITTERAL = McentE(Nombre): GoTo decim
    If Nombre < 200 Then LITTERAL = "Cent " & McentE(Right(Nombre, 2)): GoTo decim
    If Nombre < 1000 Then LITTERAL = Trim(McentE(Left(Nombre, 1)) & " Cent " & McentE(Right(Nombre, 2))): GoTo decim
    If Nombre < 2000 Then LITTERAL = Trim("Mille " & CentE(Mid(Nombre, 2, 1)) & " " & McentE(Right(Nombre, 2))): GoTo decim
    If Nombre < 10000 Then LITTERAL = Trim(McentE(Left(Nombre, 1)) & " Mille " & CentE(Mid(Nombre, 2, 1)) & " " & McentE(Right(Nombre, 2))): GoTo decim
    If Nombre < 100000 Then LITTERAL = Trim(Trim(McentE(Left(Nombre, 2)) & " Mille " & CentE(Mid(Nombre, 3, 1)) & " " & McentE(Right(Nombre, 2)))): GoTo decim
    If Nombre < 1000000 Then LITTERAL = Trim(CentE(Left(Nombre, 1)) & " " & McentE(Mid(Nombre, 2, 2)) & " Mille " & CentE(Mid(Nombre, 4, 1))) & " " & McentE(Right(Nombre, 2)): GoTo decim
    If Nombre >= 1000000 Then LITTERAL = "Un Million ou +": GoTo decim
    'pas prévu plus loin, à vous le boulot
     
    'maintenant les décimales
    decim:
      If Nombre < 2 Then Unite = Left(Unite, Len(Unite) - 1)
      If dec = False Then
        LITTERAL = LITTERAL & " " & Unite
        Exit Function
      Else
      'prevu sur 2 décimales
        LITTERAL = LITTERAL & " " & Unite & " " & McentE(Avirg)
      End If
    End Function
    Cordialement,
    Dom
    _____________________________________________
    Vous êtes nouveau ? pour baliser votre code, cliquer sur cet exemple : Anomaly
    pensez à cliquer sur si votre problème l'est
    Par contre, il est désagréable de voir une discussion résolue sans message final du demandeur (satisfaction, désarroi, remerciement, conclusion...)

  2. #2
    Membre confirmé Avatar de graphikris
    Homme Profil pro
    Pas tres doué
    Inscrit en
    Décembre 2012
    Messages
    1 214
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Pas tres doué
    Secteur : Conseil

    Informations forums :
    Inscription : Décembre 2012
    Messages : 1 214
    Points : 522
    Points
    522
    Par défaut
    Bjr,
    ton classeur contient des liaisons donc impossible a tester

  3. #3
    Expert éminent Avatar de casefayere
    Homme Profil pro
    RETRAITE
    Inscrit en
    Décembre 2006
    Messages
    5 138
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 69
    Localisation : France, Ardennes (Champagne Ardenne)

    Informations professionnelles :
    Activité : RETRAITE
    Secteur : Agroalimentaire - Agriculture

    Informations forums :
    Inscription : Décembre 2006
    Messages : 5 138
    Points : 9 548
    Points
    9 548
    Par défaut
    les liaisons sont simplement la fonction perso, il faut simplement cliquer sur continuer, sinon, pour être plus sur, copier ce code sur un classeur vierge et prendre la fonction perso "LITTERAL"
    Edit : Entre temps, j'ai changé le fichier
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
     
    Function LITTERAL(Nombre As Currency, Unite As String)
    Dim Mcent(99), McentE, Cent, CentE, i As Integer, x As Integer
    Dim dec As Boolean, Chiffre As Currency, Avirg As Currency
    If Nombre = 0 Then LITTERAL = "zero": Exit Function
    dec = False
    Chiffre = Nombre
    Nombre = Int(Chiffre)
    Avirg = Round(Chiffre - Nombre, 2)
    If Avirg <> 0 Then Avirg = Split(Avirg, ",")(1): dec = True
    If Unite = "" Then Unite = "et"
    For x = 0 To 99
      Mcent(x) = x
    Next x
    McentE = 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 Vingt", "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")
    Cent = Array(100, 200, 300, 400, 500, 600, 700, 800, 900)
    CentE = Array("", "Cent", "Deux Cent", "Trois Cent", "Quatre Cent", "Cinq Cent", "Six Cent", "Sept Cent", "Huit Cent", "Neuf Cent")
     
    If Nombre < 100 Then LITTERAL = McentE(Nombre): GoTo decim
    If Nombre < 200 Then LITTERAL = "Cent " & McentE(Right(Nombre, 2)): GoTo decim
    If Nombre < 1000 Then LITTERAL = Trim(McentE(Left(Nombre, 1)) & " Cent " & McentE(Right(Nombre, 2))): GoTo decim
    If Nombre < 2000 Then LITTERAL = Trim("Mille " & CentE(Mid(Nombre, 2, 1)) & " " & McentE(Right(Nombre, 2))): GoTo decim
    If Nombre < 10000 Then LITTERAL = Trim(McentE(Left(Nombre, 1)) & " Mille " & CentE(Mid(Nombre, 2, 1)) & " " & McentE(Right(Nombre, 2))): GoTo decim
    If Nombre < 100000 Then LITTERAL = Trim(Trim(McentE(Left(Nombre, 2)) & " Mille " & CentE(Mid(Nombre, 3, 1)) & " " & McentE(Right(Nombre, 2)))): GoTo decim
    If Nombre < 1000000 Then LITTERAL = Trim(CentE(Left(Nombre, 1)) & " " & McentE(Mid(Nombre, 2, 2)) & " Mille " & CentE(Mid(Nombre, 4, 1))) & " " & McentE(Right(Nombre, 2)): GoTo decim
    If Nombre >= 1000000 Then LITTERAL = "Un Million ou +": GoTo decim
    'pas prévu plus loin, à vous le boulot
     
    'maintenant les décimales
    decim:
      If Nombre < 2 Then Unite = Left(Unite, Len(Unite) - 1)
      If dec = False Then
        LITTERAL = LITTERAL & " " & Unite
        Exit Function
      Else
      'prevu sur 2 décimales
        LITTERAL = LITTERAL & " " & Unite & " " & McentE(Avirg)
      End If
    End Function
    Cordialement,
    Dom
    _____________________________________________
    Vous êtes nouveau ? pour baliser votre code, cliquer sur cet exemple : Anomaly
    pensez à cliquer sur si votre problème l'est
    Par contre, il est désagréable de voir une discussion résolue sans message final du demandeur (satisfaction, désarroi, remerciement, conclusion...)

  4. #4
    Membre expert
    Homme Profil pro
    Architecte de système d'information
    Inscrit en
    Juillet 2004
    Messages
    2 725
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 37
    Localisation : France, Sarthe (Pays de la Loire)

    Informations professionnelles :
    Activité : Architecte de système d'information

    Informations forums :
    Inscription : Juillet 2004
    Messages : 2 725
    Points : 3 338
    Points
    3 338
    Par défaut
    Ne fonctionne pas chez moi....
    J'ouvre le classeur et boum erreur de compilation !
    Ligne :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    If Nombre < 200 Then LITTERAL = "Cent " & McentE(Right(Nombre, 2)): GoTo decim
    Je ne comprends pas pourquoi mais impossible de savoir car quand j'arrête le deboguer l'erreur rien direct puisque le calcul du classeur n'arrive pas à se faire...

    Edit : Finalement en commentant le contenu de la fonction...
    Nom : Capture.PNG
Affichages : 754
Taille : 22,8 Ko
    Référence manquante.... Pas géniale pour une contrib
    Par pitié !!!! :Si vous ne savez pas faire cliquez ici !
    Citation Envoyé par Marc-L
    C'est dommage que parfois tu sois aussi lourd que tu as l'air intelligent…

  5. #5
    Expert éminent Avatar de casefayere
    Homme Profil pro
    RETRAITE
    Inscrit en
    Décembre 2006
    Messages
    5 138
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 69
    Localisation : France, Ardennes (Champagne Ardenne)

    Informations professionnelles :
    Activité : RETRAITE
    Secteur : Agroalimentaire - Agriculture

    Informations forums :
    Inscription : Décembre 2006
    Messages : 5 138
    Points : 9 548
    Points
    9 548
    Par défaut
    Bonsoir,
    Pas géniale pour une contrib
    Merci mais moi je n'ai pas de reference manquante, le mieux est de reprendre la fonction sur un nouveau classeur et la tester

    Ps : oublies cette partie pour l'instant, je vais même l'enlever
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    Sub PREPARER_FONCTION()
    Application.MacroOptions Macro:="Litteral", Description:="Traduit les nombres en toutes lettres", Category:=2
    End Sub
    Cordialement,
    Dom
    _____________________________________________
    Vous êtes nouveau ? pour baliser votre code, cliquer sur cet exemple : Anomaly
    pensez à cliquer sur si votre problème l'est
    Par contre, il est désagréable de voir une discussion résolue sans message final du demandeur (satisfaction, désarroi, remerciement, conclusion...)

  6. #6
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 075
    Points
    12 075
    Billets dans le blog
    8
    Par défaut re
    Bonjour casefayere
    chez moi la fichier plante bibliothèque introuvable sur la ligne >200 avec right

    pour etre sur dans le parenthèses je mettrais val(nombre)
    ce genre d'incohérence es due a un librairie absente je viens pourtant de charger le fichier aujourd'hui qui est sensé avoir été remplacé
    impossible de fermer excel ce message reviens a chaque fois
    Nom : Capture.JPG
Affichages : 1294
Taille : 167,2 Ko

    obliger de fermer dans la gestion de tache
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  7. #7
    Expert éminent Avatar de casefayere
    Homme Profil pro
    RETRAITE
    Inscrit en
    Décembre 2006
    Messages
    5 138
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 69
    Localisation : France, Ardennes (Champagne Ardenne)

    Informations professionnelles :
    Activité : RETRAITE
    Secteur : Agroalimentaire - Agriculture

    Informations forums :
    Inscription : Décembre 2006
    Messages : 5 138
    Points : 9 548
    Points
    9 548
    Par défaut
    Merci Patrick, c'est dommage et je ne comprends pas pourquoi, je n'ai aucun problème, je vais donc enlever le fichier et laisser simplement la procédure, j'espère que tu me diras si elle fonctionne correctement, bonne journée
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
     
    Function LITTERAL(Nombre As Currency, Unite As String)
    Dim Mcent(99), McentE, Cent, CentE, i As Integer, x As Integer
    Dim dec As Boolean, Chiffre As Currency, Avirg As Currency
    If Nombre = 0 Then LITTERAL = "zero": Exit Function
    dec = False
    Chiffre = Nombre
    Nombre = Int(Chiffre)
    Avirg = Round(Chiffre - Nombre, 2)
    If Avirg <> 0 Then Avirg = Split(Avirg, ",")(1): dec = True
    If Unite = "" Then Unite = "et"
    For x = 0 To 99
      Mcent(x) = x
    Next x
    McentE = 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-vingt", "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")
    Cent = Array(100, 200, 300, 400, 500, 600, 700, 800, 900)
    CentE = Array("", "Cent", "Deux Cent", "Trois Cent", "Quatre Cent", "Cinq Cent", "Six Cent", "Sept Cent", "Huit Cent", "Neuf Cent")
     
    If Nombre < 100 Then LITTERAL = McentE(Nombre): GoTo decim
    If Nombre < 200 Then LITTERAL = "Cent " & McentE(Right(Nombre, 2)): GoTo decim
    If Nombre < 1000 Then LITTERAL = Trim(McentE(Left(Nombre, 1)) & " Cent " & McentE(Right(Nombre, 2))): GoTo decim
    If Nombre < 2000 Then LITTERAL = Trim("Mille " & CentE(Mid(Nombre, 2, 1)) & " " & McentE(Right(Nombre, 2))): GoTo decim
    If Nombre < 10000 Then LITTERAL = Trim(McentE(Left(Nombre, 1)) & " Mille " & CentE(Mid(Nombre, 2, 1)) & " " & McentE(Right(Nombre, 2))): GoTo decim
    If Nombre < 100000 Then LITTERAL = Trim(Trim(McentE(Left(Nombre, 2)) & " Mille " & CentE(Mid(Nombre, 3, 1)) & " " & McentE(Right(Nombre, 2)))): GoTo decim
    If Nombre < 1000000 Then LITTERAL = Trim(CentE(Left(Nombre, 1)) & " " & McentE(Mid(Nombre, 2, 2)) & " Mille " & CentE(Mid(Nombre, 4, 1))) & " " & McentE(Right(Nombre, 2)): GoTo decim
    If Nombre >= 1000000 Then LITTERAL = "Un Million ou +": GoTo decim
    'pas prévu plus loin, à vous le boulot
     
    'maintenant les décimales
    decim:
      If Nombre < 2 Then Unite = Left(Unite, Len(Unite) - 1)
      If dec = False Then
        LITTERAL = LITTERAL & " " & Unite
        Exit Function
      Else
      'prevu sur 2 décimales
        LITTERAL = LITTERAL & " " & Unite & " " & McentE(Avirg)
      End If
    End Function
    Edit : code modifié avec les normes d'écriture des nombres
    Cordialement,
    Dom
    _____________________________________________
    Vous êtes nouveau ? pour baliser votre code, cliquer sur cet exemple : Anomaly
    pensez à cliquer sur si votre problème l'est
    Par contre, il est désagréable de voir une discussion résolue sans message final du demandeur (satisfaction, désarroi, remerciement, conclusion...)

  8. #8
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 075
    Points
    12 075
    Billets dans le blog
    8
    Par défaut re
    je l'avais déjà fait elle fonctionne apparemment je n'est pas testé beaucoup d'exemple mais ca a l'air bon

    petite parenthèse savais tu que tu pouvais le faire en ligne et avec une requête bien courte
    cela peut etre un alternative a une usine a gaz pour les très gros chiffre


    exemple
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    Option Explicit
    Sub chiffre_en_lettre()
    Dim req, URL
    Dim nombre, entier, dec, entier_en_lettre, dec_en_lettre
    nombre = 4589752257.89
    entier = Split(nombre, ",")(0)
    dec = Split(nombre, ",")(1)
    URL = "http://www.dcode.fr/api/"
    Set req = CreateObject("microsoft.xmlhttp")
    req.Open "POST", URL, False
    req.SetRequestHeader "Accept", "application/json, text/javascript, */*; q=0.01"
    req.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
    req.SetRequestHeader "X-Requested-With", "XMLHttpRequest"
    req.SetRequestHeader "Referer", "http://www.dcode.fr/ecriture-nombre-lettres"
    req.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64; Trident/7.0; rv:11.0) like Gecko"
    req.send "tool=ecriture-nombre-lettres&numbers=" & nombre & "&output=normal&reform=true"
    entier_en_lettre = Split(Split(req.responsetext, entier & """,""")(1), Chr(34))(0) & " Euros "
    dec_en_lettre = Split(Split(req.responsetext, dec & """,""")(1), Chr(34))(0) & " centimes"
    MsgBox entier_en_lettre & " et " & dec_en_lettre
    End Sub
    réponse en 20 millieme de seconde
    capture avec IE
    Nom : Capture.JPG
Affichages : 858
Taille : 89,7 Ko
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  9. #9
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    Juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : Juin 2006
    Messages : 6 132
    Points : 11 274
    Points
    11 274
    Par défaut
    Salut, il y a ceci : http://access.developpez.com/sources...ffresEnLettres ou cela, parmi une myriade.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    Option Explicit
     
    '-----------------------------------------------------------------------------
    '     Devise    =0   aucune
    '               =1   Euro €
    '               =2   Dollar $
    '------------------------------
    '     Langue    =0   Français
    '               =1   Belgique
    '               =2   Suisse
    '-----------------------------------------------------------------------------
    '
    '   Conversion limitée à 999 999 999 999 999 ou 9 999 999 999 999,99
    '   si le nombre contient plus de 2 décimales, il est arrondit à 2 décimales
    '
    '-----------------------------------------------------------------------------
     
    Public Function ConvNumberLetter(nombre As Double, Optional Devise As Byte = 0, _
                                     Optional Langue As Byte = 0) As String
    Dim dblEnt As Variant, byDec As Byte
    Dim bNegatif As Boolean
    Dim strDev As String, strCentimes As String
     
        If nombre < 0 Then
            bNegatif = True
            nombre = Abs(nombre)
        End If
     
        dblEnt = Int(nombre)
        byDec = CInt((nombre - dblEnt) * 100)
        If byDec = 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 byDec > 0 Then strDev = " virgule "
            Case 1
                strDev = " Euro"
                If dblEnt >= 1000000 And Right$(dblEnt, 6) = "000000" Then strDev = " d'Euro"
                If byDec > 0 Then strCentimes = strCentimes & " Cent"
                If byDec > 1 Then strCentimes = strCentimes & "s"
            Case 2
                strDev = " Dollar"
                If byDec > 0 Then strCentimes = strCentimes & " Cent"
        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 byDec = 0 Then
            If Devise <> 0 Then ConvNumberLetter = ConvNumberLetter & "zéro Cent"
        Else
            If Devise = 0 Then
                ConvNumberLetter = ConvNumberLetter & _
                                   ConvNumDizaine(byDec, Langue, True) & strCentimes
            Else
                ConvNumberLetter = ConvNumberLetter & _
                                   ConvNumDizaine(byDec, Langue, False) & strCentimes
            End If
        End If
        ConvNumberLetter = Replace(ConvNumberLetter, "  ", " ")
        If Left(ConvNumberLetter, 1) = " " Then ConvNumberLetter = _
           Right$(ConvNumberLetter, Len(ConvNumberLetter) - 1)
        If Right$(ConvNumberLetter, 1) = " " Then ConvNumberLetter = _
           Left(ConvNumberLetter, Len(ConvNumberLetter) - 1)
    End Function
     
    Private Function ConvNumEnt(nombre As Double, Langue As Byte)
    Dim iTmp As Variant, dblReste As Double
    Dim strTmp As String
    Dim iCent As Integer, iMille As Integer, iMillion As Integer
    Dim iMilliard As Integer, iBillion As Integer
     
        iTmp = nombre - (Int(nombre / 1000) * 1000)
        iCent = CInt(iTmp)
        ConvNumEnt = Nz(ConvNumCent(iCent, Langue))
        dblReste = Int(nombre / 1000)
        If iTmp = 0 And dblReste = 0 Then Exit Function
        iTmp = dblReste - (Int(dblReste / 1000) * 1000)
        If iTmp = 0 And dblReste = 0 Then Exit Function
        iMille = CInt(iTmp)
        strTmp = ConvNumCent(iMille, Langue)
        Select Case iTmp
            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)
        iTmp = dblReste - (Int(dblReste / 1000) * 1000)
        If iTmp = 0 And dblReste = 0 Then Exit Function
        iMillion = CInt(iTmp)
        strTmp = ConvNumCent(iMillion, Langue)
        Select Case iTmp
            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)
        iTmp = dblReste - (Int(dblReste / 1000) * 1000)
        If iTmp = 0 And dblReste = 0 Then Exit Function
        iMilliard = CInt(iTmp)
        strTmp = ConvNumCent(iMilliard, Langue)
        Select Case iTmp
            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)
        iTmp = dblReste - (Int(dblReste / 1000) * 1000)
        If iTmp = 0 And dblReste = 0 Then Exit Function
        iBillion = CInt(iTmp)
        strTmp = ConvNumCent(iBillion, Langue)
        Select Case iTmp
            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 ConvNumDizaine(nombre As Byte, Langue As Byte, bDec As Boolean) As String
    Dim TabUnit As Variant, TabDiz As Variant
    Dim byUnit As Byte, byDiz As Byte
    Dim strLiaison As String
     
        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
        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
        byDiz = Int(nombre / 10)
        byUnit = nombre - (byDiz * 10)
        strLiaison = "-"
        If byUnit = 1 Then strLiaison = " et "
        Select Case byDiz
            Case 0
                strLiaison = " "
            Case 1
                byUnit = byUnit + 10
                strLiaison = ""
            Case 7
                If Langue = 0 Then byUnit = byUnit + 10
            Case 8
                If Langue <> 2 Then strLiaison = "-"
            Case 9
                If Langue = 0 Then
                    byUnit = byUnit + 10
                    strLiaison = "-"
                End If
        End Select
        ConvNumDizaine = TabDiz(byDiz)
        If byDiz = 8 And Langue <> 2 And byUnit = 0 Then ConvNumDizaine = ConvNumDizaine & "s"
        If TabUnit(byUnit) <> "" Then
            ConvNumDizaine = ConvNumDizaine & strLiaison & TabUnit(byUnit)
        Else
            ConvNumDizaine = ConvNumDizaine
        End If
    End Function
     
    Private Function ConvNumCent(nombre As Integer, Langue As Byte) As String
    Dim TabUnit As Variant
    Dim byCent As Byte, byReste As Byte
    Dim strReste As String
     
        TabUnit = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
                        "huit", "neuf", "dix")
        byCent = Int(nombre / 100)
        byReste = nombre - (byCent * 100)
        strReste = ConvNumDizaine(byReste, Langue, False)
        Select Case byCent
            Case 0
                ConvNumCent = strReste
            Case 1
                If byReste = 0 Then
                    ConvNumCent = "cent"
                Else
                    ConvNumCent = "cent " & strReste
                End If
            Case Else
                If byReste = 0 Then
                    ConvNumCent = TabUnit(byCent) & " cents"
                Else
                    ConvNumCent = TabUnit(byCent) & " cent " & strReste
                End If
        End Select
    End Function
     
    Private Function Nz(strNb As String) As String
        If strNb <> " zéro" Then Nz = strNb
    End Function
    Images attachées Images attachées  

  10. #10
    Expert éminent Avatar de casefayere
    Homme Profil pro
    RETRAITE
    Inscrit en
    Décembre 2006
    Messages
    5 138
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 69
    Localisation : France, Ardennes (Champagne Ardenne)

    Informations professionnelles :
    Activité : RETRAITE
    Secteur : Agroalimentaire - Agriculture

    Informations forums :
    Inscription : Décembre 2006
    Messages : 5 138
    Points : 9 548
    Points
    9 548
    Par défaut
    je l'avais déjà fait
    je me posais la question si ça avait été déjà fait
    elle fonctionne apparemment je n'est pas testé beaucoup d'exemple mais ca a l'air bon
    ok merci
    petite parenthèse savais tu que tu pouvais le faire en ligne et avec une requête bien courte
    cela peut etre un alternative a une usine a gaz pour les très gros chiffre
    non je ne savais pas
    l'exercice m'a permis d'entretenir les neurores qui me restent, eh oui on vieillit encore, j'ai voulu faire ça car j'ai vu des demandes récentes sur ce sujet dont pour les dates
    merci encore et bonne contribution

    Ps : pas vu ta réponse, kiki
    Cordialement,
    Dom
    _____________________________________________
    Vous êtes nouveau ? pour baliser votre code, cliquer sur cet exemple : Anomaly
    pensez à cliquer sur si votre problème l'est
    Par contre, il est désagréable de voir une discussion résolue sans message final du demandeur (satisfaction, désarroi, remerciement, conclusion...)

  11. #11
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 075
    Points
    12 075
    Billets dans le blog
    8
    Par défaut re
    voila
    sans vouloir offenser Kki c'est de ca que je parlais quand je disais usine a gaz

    il y a certainement plus simple en terme de code je planche dessus et reviens j'ai esquisser une idée que je voudrais mettre en exécution
    avec seulement 2 array
    le premier de 0 jusqu'à 19 en lettre
    et le 2 eme de 10 a 90 en lettre

    je reviens un peu plus tard
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  12. #12
    Membre expert
    Homme Profil pro
    Architecte de système d'information
    Inscrit en
    Juillet 2004
    Messages
    2 725
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 37
    Localisation : France, Sarthe (Pays de la Loire)

    Informations professionnelles :
    Activité : Architecte de système d'information

    Informations forums :
    Inscription : Juillet 2004
    Messages : 2 725
    Points : 3 338
    Points
    3 338
    Par défaut
    Je vous propose ma version ultime :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    Function nbrToLiteral(Nombre As Variant)
        Dim i As Long, c, d, u, pow As Integer, result, tmp, et As String, mesure(), unit1(), unit10()
        mesure = Array("", " cent", " mille", " million", " milliard", " Billion", " Billiard", " Trillion", " Trilliard", " Quadrillion", " Quadrilliard", "", "", "", "", "", "", "", "", "", "", "")
        unit1 = Array("", " Un", " Deux", " Trois", " Quatre", " Cinq", " Six", " Sept", " Huit", " Neuf", " Dix", " Onze", " Douze", " Treize", " Quatorze", " Quinze", " Seize", " Dix Sept", " Dix Huit", " Dix Neuf")
        unit10 = Array("", " dix", " vingt", " trente", " quarante", " cinquante", " soixante", " soixante dix", " quatre-vingts", " quatre-vingt dix")
        Nombre = Split(StrConv(Left("000", 3 - Len(Nombre) Mod 3) & Nombre, vbUnicode), Chr(0))
        For i = UBound(Nombre) - 1 To 0 Step -3
            pow = pow + 1: c = CInt(Nombre(i - 2)): d = CInt(Nombre(i - 1)): u = CInt(Nombre(i))
            If c > 0 Then tmp = tmp & IIf(c <> 1, unit1(c), "") & mesure(1) & IIf(c > 1 And d + u = 0, "s", "")
            If (d = 1 Or d = 7 Or d = 9) And u > 0 Then tmp = tmp & unit10(d - 1) & IIf(d > 1 And d < 8 And u = 1, " et", "") & unit1(10 + u) Else tmp = tmp & IIf(d > 0, unit10(d) & IIf(d > 1 And d < 8 And u = 1, " et", "") & unit1(u), "")
            If u > 0 And d = 0 And (Not (pow = 2 And u = 1) Or c > 0) Then tmp = tmp & unit1(u)
            If pow > 1 And c + d + u > 0 Then tmp = tmp & mesure(pow) & IIf(c * 100 + d * 10 + u > 1 And pow > 2, "s", "")
            result = tmp & result: tmp = ""
        Next
        nbrToLiteral = Replace(result, Chr(0), "")
    End Function
    Sans commentaires moins de 20 lignes de codes et traites tout les nombres entiers quelque soient leur longueur !
    Edit : Petite correction.
    Par pitié !!!! :Si vous ne savez pas faire cliquez ici !
    Citation Envoyé par Marc-L
    C'est dommage que parfois tu sois aussi lourd que tu as l'air intelligent…

  13. #13
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 075
    Points
    12 075
    Billets dans le blog
    8
    Par défaut re
    re
    cerede avant de poster tu aurais du voir que lui gère les décimales nous pas encore bien que cela ne sera pas très compliqué

    casefayere si cela t'intéresse c'est toi qui m'a inspirer cette discussion
    http://www.developpez.net/forums/d15...udre-2-soucis/
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  14. #14
    Expert éminent Avatar de casefayere
    Homme Profil pro
    RETRAITE
    Inscrit en
    Décembre 2006
    Messages
    5 138
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 69
    Localisation : France, Ardennes (Champagne Ardenne)

    Informations professionnelles :
    Activité : RETRAITE
    Secteur : Agroalimentaire - Agriculture

    Informations forums :
    Inscription : Décembre 2006
    Messages : 5 138
    Points : 9 548
    Points
    9 548
    Par défaut
    Citation Envoyé par patricktoulon Voir le message
    re
    cerede avant de poster tu aurais du voir que lui gère les décimales nous pas encore bien que cela ne sera pas très compliqué

    casefayere si cela t'intéresse c'est toi qui m'a inspirer cette discussion
    http://www.developpez.net/forums/d15...udre-2-soucis/
    Merci, as-tu vu ma réponse dans l'autre forum, pour les lettres post#109
    Cordialement,
    Dom
    _____________________________________________
    Vous êtes nouveau ? pour baliser votre code, cliquer sur cet exemple : Anomaly
    pensez à cliquer sur si votre problème l'est
    Par contre, il est désagréable de voir une discussion résolue sans message final du demandeur (satisfaction, désarroi, remerciement, conclusion...)

  15. #15
    Expert confirmé
    Homme Profil pro
    retraité
    Inscrit en
    Juin 2012
    Messages
    3 183
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : retraité
    Secteur : Associations - ONG

    Informations forums :
    Inscription : Juin 2012
    Messages : 3 183
    Points : 5 515
    Points
    5 515
    Par défaut Majuscules ?
    A mon avis, il convient de tout avoir en lettres minuscules.
    La majuscule sur le premier mot est fonction du contexte: début de phrase ou pas.

    19 Dix Neuf
    20 vingt
    21 vingt et Un
    22 vingt Deux

    79 soixante Dix Neuf --- soixante-dix neuf
    80 quatre-vingts --- ok (avec s)
    81 quatre-vingts Un --- quatre-vingt un

    Maintenant, extrait de cet article sur Wikipedia
    Le rapport de 1990 sur les rectifications orthographiques proposa de nouvelles règles sur les traits d'union. Elles furent publiées dans le Journal officiel de la République française du 6 décembre 1990. On écrit les numéraux composés, avec des traits d'union entre chaque élément (ex. : vingt-et-un-mille-trois-cent-deux).
    Bon, j'ai (aussi) quitté l'école bien avant 1990 !

  16. #16
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 075
    Points
    12 075
    Billets dans le blog
    8
    Par défaut re
    salut casefayere
    apres la version de cerede2000 je te propose la mienne
    elle gre les decimale et les monais a l'arrondie 2 chiffres apres la virgule
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    Function nombre_en_lettre(nombre, Optional sstr As String = " virgule", Optional sstr2 As String = "")
        Dim i As Long, unit1, unit10, tablo, e_dec, e As Long, u, d, c
        nombre = IIf(sstr <> " virgule", Application.Round(Replace(nombre, ",", "."), 2), nombre): e_dec = Split(nombre, ","): decs = UBound(e_dec)
        unit1 = Array("", " Un", " Deux", " Trois", " Quatre", " Cinq", " Six", " Sept", " Huit", " Neuf", " Dix", " Onze", " Douze", " Treize", " Quatorze", " Quinze", " Seize", " Dix Sept", " Dix Huit", " Dix Neuf", " cent", " zero")
        unit10 = Array("", " dix", " vingt", " trente", " quarante", " cinquante", " soixante", " soixante dix", " quatre-vingts", " quatre-vingt dix", " cent")
        ms = Array("", " Quintillion", " Quatrillion", " Trillion", " Billiard", " Billion", " milliard", " million", " mille", ""): cms = UBound(ms)
        For e = 0 To UBound(e_dec)
            tablo = Split(Trim(Format(e_dec(e), Application.Rept(" @@@", cms))), " "): h = UBound(tablo)
            For i = 0 To h
                a = ms(cms - (h - i)): c = IIf(Len(tablo(i)) = 3, Mid(tablo(i), 1, 1), 0): d = IIf(Len(tablo(i)) >= 2, Mid(Right(tablo(i), 2), 1, 1), 0): u = Right(tablo(i), 1)
                c = IIf(c = 1, 20, c): ct = IIf(c > 1 And c < 10, IIf(d < 1 And u < 1, " cents", " cent"), ""): et = IIf(d > 1 And d < 8 And u = 1, "-et-", ""): u = IIf(tablo(i) = 0 And i = 0, 21, u)
                If d = 7 Or d = 9 And u > 0 Then d = d - 1: u = u + 10 Else: If d = 1 And u > 0 Then d = 0: u = u + 10: c = IIf(e = 1 And c = 0, 21, c)
                u = IIf(u = 1 And a = " mille", 0, u): s2 = IIf(tablo(i) > 1 And a <> " mille", "s", ""): sstr = IIf(decs = 0, "", sstr)
                nombre_en_lettre = nombre_en_lettre & unit1(c) & ct & unit10(d) & et & unit1(u) & IIf(tablo(i) > 0, a, "") & IIf(i < h, s2, "")
            Next
            nombre_en_lettre = nombre_en_lettre & IIf(e = 0, sstr, sstr2)
        Next
    End Function
    et pour tester
    demo
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    Sub test()
        Debug.Print nombre_en_lettre(10.45, " Euros")
        Debug.Print nombre_en_lettre(10.45)
        Debug.Print nombre_en_lettre(10.45, " Euros et", " centimes")
        Debug.Print nombre_en_lettre(10.45, " Dollards et", " cents")
        Debug.Print nombre_en_lettre(100)
        Debug.Print nombre_en_lettre(236548.96, " Euros et", " centimes")
        Debug.Print nombre_en_lettre(236548.9654265, " Euros et", " centimes")'ici l'arrondi se fera au supérieur 
        Debug.Print nombre_en_lettre(10.9654265, " € et", " Cts")
        Debug.Print nombre_en_lettre(1010101)
        Debug.Print nombre_en_lettre(1000)
        Debug.Print nombre_en_lettre("1651542525211412398745632")
        Debug.Print nombre_en_lettre("0,12")
        Debug.Print nombre_en_lettre("10,12", " Euros")
        Debug.Print nombre_en_lettre("10,035612")
        Debug.Print nombre_en_lettre("100000")
        Debug.Print nombre_en_lettre("1000000")
        Debug.Print nombre_en_lettre("1000000000")
        Debug.Print nombre_en_lettre("1000000000000")
        Debug.Print nombre_en_lettre("1000000000000000")
        Debug.Print nombre_en_lettre("1000000000000000000")
          Debug.Print nombre_en_lettre("1000000000000000000000000")
        Debug.Print nombre_en_lettre("0,012")
    Debug.Print nombre_en_lettre("200")
      Debug.Print nombre_en_lettre("201")
      Debug.Print nombre_en_lettre("241")
     
     Debug.Print nombre_en_lettre(101010101010101#)
      Debug.Print "et enfin!!!!!"
        Debug.Print nombre_en_lettre("0")
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  17. #17
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    Juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : Juin 2006
    Messages : 6 132
    Points : 11 274
    Points
    11 274
    Par défaut
    elle gre les decimale et les monais a l'arrondie 2 chiffres apres la virgule
    Salut, le poète : Debug.Print nombre_en_lettre("1101101") ?

  18. #18
    Membre expert
    Homme Profil pro
    Architecte de système d'information
    Inscrit en
    Juillet 2004
    Messages
    2 725
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 37
    Localisation : France, Sarthe (Pays de la Loire)

    Informations professionnelles :
    Activité : Architecte de système d'information

    Informations forums :
    Inscription : Juillet 2004
    Messages : 2 725
    Points : 3 338
    Points
    3 338
    Par défaut
    Ah oui bien vu @Kiki29, j'ai eu ce cas aussi à un moment
    Debug.Print nombre_en_lettre("1101101") => Un million cent mille cent Un
    Mais où est donc le Un
    Par pitié !!!! :Si vous ne savez pas faire cliquez ici !
    Citation Envoyé par Marc-L
    C'est dommage que parfois tu sois aussi lourd que tu as l'air intelligent…

  19. #19
    Expert éminent

    Homme Profil pro
    Curieux
    Inscrit en
    Juillet 2012
    Messages
    5 073
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : Curieux
    Secteur : Arts - Culture

    Informations forums :
    Inscription : Juillet 2012
    Messages : 5 073
    Points : 9 853
    Points
    9 853
    Billets dans le blog
    5
    Par défaut
    Citation Envoyé par patricktoulon Voir le message
    Bonjour casefayere
    chez moi la fichier plante bibliothèque introuvable sur la ligne >200 avec right

    pour etre sur dans le parenthèses je mettrais val(nombre)
    ce genre d'incohérence es due a un librairie absente je viens pourtant de charger le fichier aujourd'hui qui est sensé avoir été remplacé
    impossible de fermer excel ce message reviens a chaque fois
    Nom : Capture.JPG
Affichages : 1294
Taille : 167,2 Ko

    obliger de fermer dans la gestion de tache
    Bonjour,

    bien que ce problème n'est plus d'actualité visible ...

    Patrick, si ça plante sur un Right / Mid / Len / Left et autres fonctions joyeuses, en indiquant un problème de bibliothèque ou de référence... en général un préfixe VBA et ça repart

    VBA.Mid()
    VBA.Left()
    etc...


    tu nous dis si c'était ça ?

  20. #20
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 075
    Points
    12 075
    Billets dans le blog
    8
    Par défaut re
    re
    Bonjour joe
    non c'était bien de références manquantes dans son classeur
    son code dans un fichier vierge fonctionnait j'ai pas tester divers nombres mais pas de plantage

    je suis en train de finaliser ma dernière version sur mon post je la proposerais une fois fini et testé et tordue dans tout les sens
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

Discussions similaires

  1. [AC-2010] Incrémentation automatique sur chiffre ou lettre en fonction d'un critère
    Par MelaAllIn dans le forum VBA Access
    Réponses: 3
    Dernier message: 27/08/2015, 14h17
  2. [CR XI] Fonction de conversion de chiffre en lettre
    Par GodGives dans le forum SAP Crystal Reports
    Réponses: 5
    Dernier message: 18/05/2009, 19h46
  3. Fonction convertissant les chiffres en lettres
    Par damene dans le forum Débuter
    Réponses: 1
    Dernier message: 04/04/2008, 13h32
  4. Réponses: 1
    Dernier message: 30/05/2007, 18h19
  5. pl/sql fonction de conversion de chiffres en lettres
    Par sawasbanikh dans le forum PL/SQL
    Réponses: 1
    Dernier message: 18/04/2007, 14h52

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo