Transformer un chiffre en lettre


#1

Bonjour
Je souhaiterai qu’un chiffre dans une case ex: 2000 en A1 devienne Deux mille € dans une autre case F5 par exemple


#2

Bonjour @Roger,

Voici une macro qui n’est pas de moi, alors je ne l’expliquerai pas.
Elle fonctionne comme une fonction native d’Excel:

=ConvNumberLetter(Cellule;1)

Pour avoir les première lettre en majuscule:

=NOMPROPRE(ConvNumberLetter(Cellule;1))

La macro:

Option Explicit

'------------------------------------------------------------------------------------
' Devise=0   aucune
'       =1   Euro ?
'       =2   Dollar $
'------------------------------------------------------------------------------------
'
'   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 & " Centime"
            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

Fichier exemple ICI==> Roger V1.xlsm (24,5 Ko)

Cordialement.


#3

Bonjour mod100
Je suppose que la macro est bonne, mais pour moi débutant ???
Je travaille avec office2016 sur windows 10
Dans mon tableau, je voudrais que le chiffre numérique qui s’inscrit dans la cellule B41, s’inscrive en lettres dans la cellule K32
Je clic sur développeur,Visual basic,clic droit sur Microsoft Excel Objets, inserer, puis modue.
Après je plane


#4

Re @Roger,

Oui c’est ça:

  1. Clic sur l’onglet Développeur

  2. Puis Visual basic

  3. Puis dans la fenêtre qui vient de s’ouvrir cliquer sur l’onglet Insertion.

  4. Choisir Module

  5. Copier la macro que j’ai fournie et la coller dans ce Module

Ensuite écrire en “K32

=NOMPROPRE(ConvNumberLetter(B41;1))

Voila, c’est tout. :wink:

Cordialement.


#5

Re
Merci voila c’est plus clair


#6

Bonjour
Cela à fontionner, mais maintenant plus rienFactures.xlsx (16,4 Ko)


#7

Bonjour,

Tu réitères les explications de MDO 100, et il faut l’enregistrer sous :

Classeur Excel (prenant en charge les macros)(*.xlsm)
sinon les macros ne sont pas enregistrées

Factures.xlsm (28,1 Ko)


#8

Bonjour Miminathy88

Un grand merci, cela fonctionne très bien

Cordialement

Roger

Provenance :
Courrier
pour Windows 10


#9

Bonjour
Merci MDO100 pour la macro mais je pense que pour les débutants il serait plus facile de passer par le composant suivant: https://www.cjoint.com/c/HIyjFr82VJ1

  1. Aller dans fichier
    2.Option
    3.Complément
    4.Appuyer sur la touche ATTEINDRE puis PARCOURIR et sélectionne le fichier NBLETTER et OK
    Maintenant vous pouvez utiliser la formule =ConvNumberLetter(F5)

#10

Bonjour Cheikh Ndiaye

Vous avez certainement raison, il faut savoir simplifier les choses, d’où parfois le problème des spécialistes mais que je remercie pour le temps et le savoir qu’ils nous donnent gratieusement.

Roger

Provenance :
Courrier
pour Windows 10


#11

Ce sujet a été automatiquement fermé après 30 jours. Aucune réponse n’est permise dorénavant.