Conversion chiffre en nombre

Résolu

nonossov Messages postés 610 Date d'inscription Statut Membre Dernière intervention -
gbinforme Messages postés 14946 Date d'inscription Statut Contributeur Dernière intervention - 23 févr. 2017 à 13:50

Bonjour mes amis,

J’ai cette macro qui fait la conversion des chiffres en Lettre en ajoutant "convertible" a la fin le problème est lorsque je mets un nombre avec la virgule elle ajoute "convertible" au premier et à la fin.

Function NombreTexte(valConv As String, Optional convDéci As Variant, _
  Optional monnaieDéci As Variant) As String

  Dim textMon As libMonnaie   'paramètres liés à la monnaie choisie
  Dim valEnt As String        'partie entière du nombre
  Dim valDéci As String       'partie décimale du nombre
  Dim sepDéci As String * 1   'séparateur décimal de l'utilisateur

  If Not (IsNumeric(valConv)) Then
    NombreTexte = "#VALEUR!"
    Exit Function
  End If
  'If Len(valConv) > 16 Then
  If Len(valConv) > 32 Then
    NombreTexte = "#Hors Limites!"
    Exit Function
  End If
  If Not IsError(Application.Search("E", valConv)) Then
    NombreTexte = "#Hors limites!"
    Exit Function
  End If

  If IsMissing(convDéci) Then convDéci = True
  If convDéci = "" Then convDéci = True
  If IsMissing(monnaieDéci) Then monnaieDéci = "F"
  If monnaieDéci = "" Then monnaieDéci = "F"
  If Not (IsNumeric(monnaieDéci)) Then
     monnaieDéci = UCase(monnaieDéci)
     textMon = ChoixLangue(monnaieDéci)
  Else
     textMon = ChoixLangue("Aucun")
     textMon.nbreDéci = monnaieDéci
  End If

  If textMon.nbreDéci <> -1 Then
    valConv = CStr(Application.Round(CDbl(valConv), textMon.nbreDéci))
    If Not IsError(Application.Search("E", valConv)) Then
      NombreTexte = "#Hors Limites!"
      Exit Function
    End If
  End If

  sepDéci = Application.International(xlDecimalSeparator)
  If Fix(CDbl(valConv)) = CDbl(valConv) Then
    valEnt = LTrim(valConv)
    valDéci = "0"
  Else
    valEnt = LTrim(Left(valConv, Application.Search(sepDéci, valConv) - 1))
    valDéci = Right(valConv, Len(valConv) - _
              Application.Search(sepDéci, valConv))
    If Len(valDéci) < textMon.nbreDéci Then
      For i = 1 To textMon.nbreDéci - Len(valDéci)
        valDéci = valDéci & "0"
      Next
    End If
  End If

  If CDbl(valConv) = 0 Then
    NombreTexte = "ZERO" & textMon.libFranc
  Else
    NombreTexte = ""
    If Left(valEnt, 1) = "-" Then
      NombreTexte = "moins "
      valEnt = Right(valEnt, Len(valEnt) - 1)
    End If
    If CDbl(valEnt) = 0 Then
      NombreTexte = NombreTexte & "ZERO"
    Else
      NombreTexte = NombreTexte & ConvTexte(valEnt, textMon.estMon, False)
    End If
    If valEnt <> "UN" And valEnt <> "1" Then
      NombreTexte = NombreTexte & textMon.libFrancs
    Else
      NombreTexte = NombreTexte & textMon.libFranc
    End If
    If textMon.estMon Then
      Do While Left(valDéci, 1) = "0" And Len(valDéci) > 1
        valDéci = Right(valDéci, Len(valDéci) - 1)
      Loop
    End If
    If valDéci <> "0" Then
      NombreTexte = NombreTexte & textMon.sepDéci
      If convDéci Then
        NombreTexte = NombreTexte & ConvTexte(valDéci, textMon.estMon, True)
      Else
        NombreTexte = NombreTexte & valDéci
      End If
      If valDéci <> "UN" And valDéci <> "1" Then
        NombreTexte = NombreTexte & textMon.libCentimes
      Else
        NombreTexte = NombreTexte & textMon.libCentime
      End If
    End If
  End If

End Function

Private Function ChoixLangue(ByVal codePays As String) As libMonnaie

  Select Case codePays
    Case "F"
      ChoixLangue.libFranc = " DIRHAMS"
      ChoixLangue.libFrancs = " DIRHAMS CONVERTIBLE"
      ChoixLangue.libCentime = " CENTIME CONVERTIBLE"
      ChoixLangue.libCentimes = " CENTIMES CONVERTIBLE"
      ChoixLangue.sepDéci = " ET "
      ChoixLangue.nbreDéci = 2
      ChoixLangue.estMon = True
'Comme pour le franc, les montants en euros s'expriment avec deux
'chiffres après la virgule parce que la plus petite subdivision sera
'le " CENTS " d'euro.
'les valeurs des billets (5, 10, 20, 50, 100, 200, 500 euros)
'et des pièces (1, 2, 5, 10, 20, 50 CENTS), ET (1 et 2 euros)
'étaient définies par accord des Quinze dès 1995.
    Case "€"
      ChoixLangue.libFranc = " DIRHAM"
      ChoixLangue.libFrancs = " DIRHAMS"
      ChoixLangue.libCentime = " CENTIME CONVERTIBLE" '(d'euro)"
      ChoixLangue.libCentimes = " CENTIMES CONVERTIBLE" '(d'euro)"
      ChoixLangue.sepDéci = " ET "
      ChoixLangue.nbreDéci = 2
      ChoixLangue.estMon = True
    Case "$US"
      ChoixLangue.libFranc = " dollar"
      ChoixLangue.libFrancs = " dollars"
      ChoixLangue.libCentime = " CENTS"
      ChoixLangue.libCentimes = " CENTS"
      ChoixLangue.sepDéci = " ET "
      ChoixLangue.nbreDéci = 2
      ChoixLangue.estMon = True
    Case "£"
      ChoixLangue.libFranc = " livre"
      ChoixLangue.libFrancs = " livres"
      ChoixLangue.libCentime = " penny"
      ChoixLangue.libCentimes = " pence"
      ChoixLangue.sepDéci = " ET "
      ChoixLangue.nbreDéci = 2
      ChoixLangue.estMon = True
    Case "DH"
      ChoixLangue.libFranc = " DIRHAMS CONVERTIBLE"
      ChoixLangue.libFrancs = " DIRHAMS"
      ChoixLangue.libCentime = " CENTIME CONVERTIBLE"
      ChoixLangue.libCentimes = " CENTIMES CONVERTIBLE"
      ChoixLangue.sepDéci = " ET "
      ChoixLangue.nbreDéci = 2
      ChoixLangue.estMon = True
    Case Else
      ChoixLangue.libFranc = ""
      ChoixLangue.libFrancs = ""
      ChoixLangue.libCentime = ""
      ChoixLangue.libCentimes = ""
      ChoixLangue.sepDéci = " virgule "
      ChoixLangue.nbreDéci = -1
      ChoixLangue.estMon = False
  End Select

End Function

Private Function ConvTexte(sourceConv As String, estMonnaie As Boolean, _
  zéroGauche As Boolean) As String

  ConvTexte = ""
  Do While Left(sourceConv, 1) = "0"
    If zéroGauche Then ConvTexte = ConvTexte & "ZERO "
    sourceConv = Right(sourceConv, Len(sourceConv) - 1)
  Loop

  Select Case Len(sourceConv)
    Case 1, 2, 3
      ConvTexte = ConvTexte & ConvCent(sourceConv, True)
    Case 4, 5, 6
      Select Case Left(sourceConv, Len(sourceConv) - 3)
        Case "000"
          ConvTexte = ConvTexte & ""
        Case "1", "001"
          If Right(sourceConv, 3) = "000" Then
            'Dernir texte
            ConvTexte = ConvTexte & "MILLES"
          Else
            ConvTexte = ConvTexte & "MILLE " & ConvTexte(Right(sourceConv, 3), estMonnaie, _
                        False)
          End If
        Case Else
          If Right(sourceConv, 3) = "000" Then
            ConvTexte = ConvTexte & ConvCent(Left(sourceConv, Len(sourceConv) - 3), _
                        False) & " MILLES"
          Else
            ConvTexte = ConvTexte & ConvCent(Left(sourceConv, Len(sourceConv) - 3), _
                        False) & " MILLE " & ConvTexte(Right(sourceConv, 3), _
                        estMonnaie, False)
          End If
      End Select
    Case 7, 8, 9
      Select Case Left(sourceConv, Len(sourceConv) - 6)
        Case "000"
          ConvTexte = ConvTexte & ""
        Case "1", "001"
          If Right(sourceConv, 6) = "000000" Then
            ConvTexte = ConvTexte & "UN MILLION"
            If estMonnaie Then ConvTexte = ConvTexte & " de"
          Else
            ConvTexte = ConvTexte & "UN MILLION " & ConvTexte(Right(sourceConv, 6), _
                        estMonnaie, False)
          End If
        Case Else
          If Right(sourceConv, 6) = "000000" Then
            ConvTexte = ConvTexte & ConvCent(Left(sourceConv, Len(sourceConv) - 6), _
                        True) & " millions"
            If estMonnaie Then ConvTexte = ConvTexte & " de"
          Else
            ConvTexte = ConvTexte & ConvCent(Left(sourceConv, Len(sourceConv) - 6), _
                        True) & " millions " & ConvTexte(Right(sourceConv, 6), _
                        estMonnaie, False)
          End If
      End Select
    Case 10, 11, 12
      Select Case Left(sourceConv, Len(sourceConv) - 9)
        Case "000"
          ConvTexte = ConvTexte & ""
        Case "1", "001"
          If Right(sourceConv, 9) = "000000000" Then
            ConvTexte = ConvTexte & "UN milliard"
            If estMonnaie Then ConvTexte = ConvTexte & " de"
          Else
            ConvTexte = ConvTexte & "UN milliard " & ConvTexte(Right(sourceConv, 9), _
                        estMonnaie, False)
          End If
        Case Else
          If Right(sourceConv, 9) = "000000000" Then
            ConvTexte = ConvTexte & ConvCent(Left(sourceConv, Len(sourceConv) - 9), _
                        True) & " milliards"
            If estMonnaie Then ConvTexte = ConvTexte & " de"
          Else
            ConvTexte = ConvTexte & ConvCent(Left(sourceConv, Len(sourceConv) - 9), _
                        True) & " milliards " & ConvTexte(Right(sourceConv, 9), _
                        estMonnaie, False)
          End If
      End Select
    Case 13, 14, 15
      Select Case Left(sourceConv, Len(sourceConv) - 12)
        Case "000"
          ConvTexte = ConvTexte & ""
        Case "1", "001" '1 seul billion
          If Right(sourceConv, 12) = "000000000000" Then
            'Dernier texte
            ConvTexte = ConvTexte & "UN billion"
            If estMonnaie Then ConvTexte = ConvTexte & " de"
          Else
            ConvTexte = ConvTexte & "UN billion " & ConvTexte(Right(sourceConv, 12), _
                        estMonnaie, False)
          End If
        Case Else
          If Right(sourceConv, 12) = "000000000000" Then
            ConvTexte = ConvTexte & ConvCent(Left(sourceConv, Len(sourceConv) - 12), _
                        True) & " billions"
            If estMonnaie Then ConvTexte = ConvTexte & " de"
          Else
            ConvTexte = ConvTexte & ConvCent(Left(sourceConv, Len(sourceConv) - 12), _
                        True) & " billions " & ConvTexte(Right(sourceConv, _
                        12), estMonnaie, False)
          End If
      End Select
    Case Else
      ConvTexte = "#Hors Limites!"
  End Select

  ConvTexte = LTrim(RTrim(ConvTexte))

End Function

Private Function ConvCent(source As String, estFinal As Boolean) As String

  Dim tabUnit As Variant
  Dim tabDixUnit As Variant
  Dim tabDixaine As Variant

  tabUnit = Array("ZERO", "UN", "DEUX", "TROIS", "QUATRE", "CINQ", "SIX", _
            "SEPT", "HUIT", "NEUF")
  tabDixUnit = Array("DIX", "ONZE", "DOUZE", "TREIZE", "QUATORZE", "QUINZE", _
               "SEIZE", "DIX-SEPT", "DIX-HUIT", "DIX-NEUF")
  tabDixaine = Array("", "DIX", "VINGT", "TRENTE", "QUARANTE", "CINQUANTE", _
               "SOIXANTE", "SOIXANTE-DIX", "QUATRE-VINGT", "QUATRE-VINGT-DIX")

  Select Case Len(source)
    Case 1
      ConvCent = tabUnit(CDbl(source))
    Case 2
      Select Case Left(source, 1)
        Case "0"
          ConvCent = ConvCent(Right(source, 1), estFinal)
        Case "1"
          ConvCent = tabDixUnit(CDbl(Right(source, 1)))
        Case "2", "3", "4", "5", "6"
          Select Case Right(source, 1)
            Case "0"
              ConvCent = tabDixaine(CDbl(Left(source, 1)))
            Case "1"
              ConvCent = tabDixaine(CDbl(Left(source, 1))) & " ET UN"
            Case Else
              ConvCent = tabDixaine(CDbl(Left(source, 1))) & "-" & _
                ConvCent(Right(source, 1), estFinal)
          End Select
        Case "7"
          Select Case Right(source, 1)
            Case "0"
              ConvCent = tabDixaine(CDbl(Left(source, 1)))
            Case "1"
              ConvCent = "SOIXANTE ET ONZE"
            Case Else
              ConvCent = "SOIXANTE-" & ConvCent("1" & Right(source, 1), _
                         estFinal)
          End Select
        Case "8"
          If Right(source, 1) = "0" Then
            If estFinal Then
              ConvCent = "QUATRE-VINGTS"
            Else
              ConvCent = "QUATRE-VINGT"
            End If
          Else
            ConvCent = "QUATRE-VINGT-" & ConvCent(Right(source, 1), estFinal)
          End If
        Case "9"
          ConvCent = "QUATRE-VINGT-" & ConvCent("1" & Right(source, 1), _
                     estFinal)
      End Select
    Case 3
      Select Case Left(source, 1)
        Case "0"
          ConvCent = ConvCent(Right(source, 2), estFinal)
        Case "1"
          If Right(source, 2) = "00" Then
            ConvCent = "CENTS"
          Else
            ConvCent = "CENTS " & ConvCent(Right(source, 2), estFinal)
          End If
        Case Else
          If Right(source, 2) = "00" Then
            If estFinal Then
              ConvCent = ConvCent(Left(source, 1), estFinal) & " CENTS"
            Else
              ConvCent = ConvCent(Left(source, 1), estFinal) & " CENTS"
            End If
          Else
            ConvCent = ConvCent(Left(source, 1), estFinal) & " CENTS " & _
              ConvCent(Right(source, 2), estFinal)
          End If
      End Select
  End Select
End Function

Afficher la suite

A voir également:

Conversion chiffre en nombre
Excel trier par ordre croissant chiffre - Guide
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
Clavier iphone chiffre et lettre - Guide
Chiffre en lettre - Télécharger - Outils professionnels
Nombre de jours entre deux dates excel - Guide

2 réponses

Réponse 1 / 2

The_boss_68 Messages postés 952 Date d'inscription Statut Membre Dernière intervention 182

Bonjour

Quel est la différence entre des chiffres et des nombres?

Slts

nonossov Messages postés 610 Date d'inscription Statut Membre Dernière intervention

Pardon j'ai voulu dire lettre

Réponse 2 / 2

gbinforme Messages postés 14946 Date d'inscription Statut Contributeur Dernière intervention 4 724

Bonjour,

Tu as sans doute récupéré cette macro, ce serait plus simple de demander au concepteur de la modifier car comme l'on a pas les moyens de tout tester, si l'on intervient sur une partie, le reste risque de créer d'autres soucis.

nonossov Messages postés 610 Date d'inscription Statut Membre Dernière intervention

Bnjr,
Le concepteur est abscent je ne peux pas le contacter, si vous voulez je peux cjoint le fichier excel, juste essayer de m'aider, juste modifier le code de la macro?

gbinforme Messages postés 14946 Date d'inscription Statut Contributeur Dernière intervention 4 724

Bonjour,

Je comprends bien ta démarche mais pour modifier la macro ce n'est pas si simple.
Cette macro gère plusieurs langues et devises et dans le cas du "convertible" qui te préoccupe, il y a 8 positions concernées.
Donc je veux bien t'aider, mais il va falloir passer des heures pour déterminer où intervenir (probablement 8 endroits différents) et lorsque l'on aura modifié, tu t'apercevras qu'autre chose à été perturbé dans un autre cas où il n'y a pas de décimales.
Personnellement, cela ne m'inspire pas beaucoup, aussi si quelqu'un est intéressé, pas de souci pour intervenir.

Bien cordialement.

nonossov Messages postés 610 Date d'inscription Statut Membre Dernière intervention

Bien compris Mr, mais si je veux d'autres macro qui travail sur Euro Dollars et Dirham Marocain, comment je peux deduire ça?

nonossov Messages postés 610 Date d'inscription Statut Membre Dernière intervention

Mr est ce que vous avez compris la question?

gbinforme Messages postés 14946 Date d'inscription Statut Contributeur Dernière intervention 4 724

Bonjour nonossov,

Je ne comprend pas très bien mais si tu veux d'autres macros il te faut faire des recherches car cela doit sans doute exister.

Discussions similaires

Transformer un chiffre en lettres dans excel sans macro

Tatouage date chiffres romains

différence entre Mo et MB

Combinaisons possibles avec 3 séries de 3 nombres

Votre réponse

Discussions similaires