Formule Excel

JahdesBlanche Messages postés 2 Statut Membre -  
JahdesBlanche Messages postés 2 Statut Membre -
Bonjour,

S'il vous plait, je recherche une formule en Excel qui permet de transformer un montant chiffre en un montant en lettres. Je travaille sur Windows 8, svp.
Merci.

1 réponse

  1. eljojo_e Messages postés 1255 Statut Membre 155
     
    Bonjour,

    utilise ca :

    Type libMonnaie           'type décrivant les paramètres d'un pays
    libFranc As String 'libellé pour la monnaie principale, au singulier
    libFrancs As String 'libellé pour la monnaie principale, au pluriel
    libCentime As String 'libellé pour la monnaie secondaire, au singulier
    libCentimes As String 'libellé pour la monnaie secondaire, au pluriel
    sepDéci As String 'texte de séparation entre partie entière et décimale
    nbreDéci As Integer 'nombre de décimales
    estMon As Boolean 's'agit-il d'une monnaie
    End Type

    Function NombreTexte(valConv As String, Optional monnaieDéci As Variant, _
    Optional convDé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 = "Pas de nombre détecté"
    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 = "Zéro" & 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 & "Zéro"
    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 = " franc"
    ChoixLangue.libFrancs = " francs"
    ChoixLangue.libCentime = " centime"
    ChoixLangue.libCentimes = " centimes"
    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 " cent " 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 = " Euro"
    ChoixLangue.libFrancs = " Euros"
    ChoixLangue.libCentime = " centime" '(d'euro)"
    ChoixLangue.libCentimes = " centimes" '(d'euro)"
    ChoixLangue.sepDéci = " et "
    ChoixLangue.nbreDéci = 2
    ChoixLangue.estMon = True
    Case "$US"
    ChoixLangue.libFranc = " dollar"
    ChoixLangue.libFrancs = " dollars"
    ChoixLangue.libCentime = " cent"
    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 "DM"
    ChoixLangue.libFranc = " mark"
    ChoixLangue.libFrancs = " marks"
    ChoixLangue.libCentime = " pfennig"
    ChoixLangue.libCentimes = " pfennige"
    ChoixLangue.sepDéci = " et "
    ChoixLangue.nbreDéci = 2
    ChoixLangue.estMon = True
    Case "PTA"
    ChoixLangue.libFranc = " peseta"
    ChoixLangue.libFrancs = " pesetas"
    ChoixLangue.libCentime = " céntimo"
    ChoixLangue.libCentimes = " céntimos"
    ChoixLangue.sepDéci = " et "
    ChoixLangue.nbreDéci = 2
    ChoixLangue.estMon = True
    Case "DTU"
    ChoixLangue.libFranc = " dinar"
    ChoixLangue.libFrancs = " dinars"
    ChoixLangue.libCentime = " millime"
    ChoixLangue.libCentimes = " millimes"
    ChoixLangue.sepDéci = " et "
    ChoixLangue.nbreDéci = 3
    ChoixLangue.estMon = True
    Case "Y"
    ChoixLangue.libFranc = " yen"
    ChoixLangue.libFrancs = " yen"
    ChoixLangue.libCentime = " sen"
    ChoixLangue.libCentimes = " sen"
    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 & "zéro "
    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 & "mille"
    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) & " mille"
    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("zéro", "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 = "cent"
    Else
    ConvCent = "cent " & 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) & " cent"
    End If
    Else
    ConvCent = ConvCent(Left(source, 1), estFinal) & " cent " & _
    ConvCent(Right(source, 2), estFinal)
    End If
    End Select
    End Select
    End Function


    Ensuite tu écris : =NombreTexte(G6;"€") (G6 étant la cellule ciblé)
    0
    1. JahdesBlanche Messages postés 2 Statut Membre
       
      Bonjour,

      Très content pour promptitude mais malheureusement, après application de la formule, je reçois un message d'erreur pour formule trop longue.
      Merci.
      0