Sujet Précédent Sujet Suivant

Conversion chiffre en nombre

Résolu/Fermé
nonossov Messages postés 610 Date d'inscription lundi 29 décembre 2014 Statut Membre Dernière intervention 17 janvier 2020 - Modifié par nonossov le 20/02/2017 à 17:33
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 - 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




2 réponses

Réponse 1 / 2
The_boss_68 Messages postés 928 Date d'inscription dimanche 15 novembre 2015 Statut Membre Dernière intervention 10 juin 2024 177
20 févr. 2017 à 17:10
Bonjour

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

Slts
0
nonossov Messages postés 610 Date d'inscription lundi 29 décembre 2014 Statut Membre Dernière intervention 17 janvier 2020
20 févr. 2017 à 17:31
Pardon j'ai voulu dire lettre
0
Réponse 2 / 2
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 709
21 févr. 2017 à 08:33
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.
0
nonossov Messages postés 610 Date d'inscription lundi 29 décembre 2014 Statut Membre Dernière intervention 17 janvier 2020
21 févr. 2017 à 10:19
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?
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 709
21 févr. 2017 à 13:34
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.
0
nonossov Messages postés 610 Date d'inscription lundi 29 décembre 2014 Statut Membre Dernière intervention 17 janvier 2020
21 févr. 2017 à 15:31
Bien compris Mr, mais si je veux d'autres macro qui travail sur Euro Dollars et Dirham Marocain, comment je peux deduire ça?
0
nonossov Messages postés 610 Date d'inscription lundi 29 décembre 2014 Statut Membre Dernière intervention 17 janvier 2020
23 févr. 2017 à 12:05
Mr est ce que vous avez compris la question?
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 709
23 févr. 2017 à 13:50
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.
0

Discussions similaires

Accès a Snapchat temporairement désactivé
Nz0_5123 -
Yeboua -

4 réponses
en chiffre un milliard un million mille un
pout -
chossette9 -

3 réponses
Toutes les combinaisons à 4 chiffres de 0000 a 9999
Sarah -
baladur13 -

11 réponses
Conversion Bytes à Mo
Utilisateur anonyme -
papoute76 -

8 réponses
Convertir des m3 en metre
Al 04 -
jisisv -

2 réponses