convertir les chiffre en lettre

[nkea.sat]

bonjour forum,

je souhaiterai convertir les chiffres d'une cellule A1 en lettre dans une autre cellule A2

merci de votre aide.

 

[Guillaumega]

Re : convertir les chiffre en lettre

Bonjour,

Tu peux utiliser la fonction suivante si tu le souhaites :

Option Explicit


'***********
' Devise=0   aucune
'       =1   Euro €
'       =2   Dollar $
'       =3   €uro €
' Langue=0   Français
'       =1   Belgique
'       =2   Suisse
' Casse =0   Minuscule
'       =1   Majuscule en début de phrase
'       =2   Majuscule
'       =3   Majuscule en début de chaque mot
' ZeroCent=0   Ne mentionne pas les cents s'ils sont égal à 0
'         =1   Mentionne toujours les cents
'***********
' 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, _
                                    Optional Casse As Byte = 0, _
                                    Optional ZeroCent 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"
        Case 3
            strDev = " €uro"
            If dblEnt >= 1000000 And Right(dblEnt, 6) = "000000" Then strDev = " d'€uro"
            If byDec > 0 Then strCentimes = strCentimes & " Cent"
            If byDec > 1 Then strCentimes = strCentimes & "s"
    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
            If ZeroCent = 1 Then ConvNumberLetter = ConvNumberLetter & "zéro Cent"
        End If
    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)
    Select Case Casse
        Case 0
            ConvNumberLetter = LCase(ConvNumberLetter)
        Case 1
            ConvNumberLetter = UCase(Left(ConvNumberLetter, 1)) & _
                LCase(Right(ConvNumberLetter, Len(ConvNumberLetter) - 1))
        Case 2
            ConvNumberLetter = UCase(ConvNumberLetter)
        Case 3
            ConvNumberLetter = Application.WorksheetFunction.Proper(ConvNumberLetter)
            If Devise = 3 Then _
                ConvNumberLetter = Replace(ConvNumberLetter, "€Uros", "€uros", , , vbTextCompare)
    End Select
End Function

 

[nkea.sat]

Re : convertir les chiffre en lettre

merci guillaumega,

seulement j'au du mal a comprendre ton code, et en plus je ne vois pas a quel moment apparaisse A1 et A2, stp, peux tu m'expliquer un peu ton code.

 

[Guillaumega]

Re : convertir les chiffre en lettre

Re,

tu fais alt F11 pour aller dans le VBE. Tu copies le code dans un module.
Tu actives les macros si elles sont inactives.

Puis en a2 tu tapes :

=ConvNumberLetter(A1)

J'espère avoir été clair.

Bien à toi,
Guillaumega

 

[kdet]

Re : convertir les chiffre en lettre

Re,

tu fais alt F11 pour aller dans le VBE. Tu copies le code dans un module.
Tu actives les macros si elles sont inactives.

Puis en a2 tu tapes :

=ConvNumberLetter(A1)

J'espère avoir été clair.

Bien à toi,
Guillaumega

Bonjour Guillaumega, Bonjour le forum, Bonjour à tous et à toutes,

Concernant le code, en A1 j'ai comme chiffre 350,75 et quand je tape en A2 la formule =ConvNumberLetter(A1), la réponse est : trois cent cinquante "virgule" soixante quinze. Comment enlever le mot virgule??

Merci

 

[analyseaux]

Re : convertir les chiffre en lettre

bjr
je te propose ceci

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 08/12/2009 par ENSH
'
Function CHIFLETR(Nombre, Optional Monnaie As String = "euro", Optional Maju As Boolean = True)

' CETTE FONCTION TRADUIT EN LETTRES UN NOMBRE POSITIF INFERIEUR
' AU MILLIARD, AVEC DEUX DECIMALES

' Elle fait appel à la macro "Codage" ci-dessous,
' qui en est indissociable

Dim TrCent As Boolean
Dim CenTouRon As Boolean

Dim Entiers As Long
Dim Centimes As Long

Dim TrUnités As Integer
Dim TrMilles As Integer
Dim TrMlions As Integer

Dim QuUnités As Long
Dim QuMilles As Long
Dim QuMlions As Long

Dim Lib As String

If Nombre > 999999999.99 Then
CHIFLETR = ""
Exit Function
End If

Entiers = Int(Nombre)
Centimes = (Nombre - Entiers) * 100
TrUnités = Entiers Mod 1000
QuUnités = Entiers \ 1000
TrMilles = QuUnités Mod 1000
QuMilles = QuUnités \ 1000
TrMlions = QuMilles Mod 1000
QuMlions = QuMilles \ 1000

Lib = ""

CenTouRon = (Entiers Mod 100) = 0

If TrMlions <> 0 Then
Call Codage(TrMlions, Lib, CenTouRon, False)
If TrMlions = 1 Then
Lib = Lib & "million "
Else
Lib = Lib & "millions "
End If
End If

If TrMilles <> 0 Then
If TrMilles <> 1 Then
Call Codage(TrMilles, Lib, CenTouRon, False)
End If
Lib = Lib & "mille "
End If

If TrUnités <> 0 Then
Call Codage(TrUnités, Lib, CenTouRon, True)
End If

If Entiers >= 2 Then
Lib = Lib & Monnaie & "s "
ElseIf Entiers >= 1 Then
Lib = Lib & Monnaie & " "
Else
Lib = "zéro " & Monnaie & " "
End If
If Centimes <> 0 Then
Lib = Lib & "et "
Call Codage(Centimes, Lib, CenTouRon, False)
If Centimes = 1 Then
Lib = Lib & "centime "
Else
Lib = Lib & "centimes "
End If
End If

CHIFLETR = Lib

If Maju Then CHIFLETR = UCase(CHIFLETR)

End Function
Sub Codage(Tranche, Lib, CenTouRon, TrCent)

' CETTE MACRO EST INDISSOCIABLE DE LA FONCTION CHIFLETR
' CI-DESSUS, ET TRADUIT EN LETTRES UNE TRANCHE DE 3 CHIFFRES

Dim C As Byte, D As Byte, D1 As Byte, U As Byte
Dim T00 As Variant
Dim Tb0 As Variant, Tb1 As Variant, Tb2 As Variant, Tb3 As Variant, Tb4 As Variant
Dim Tb5 As Variant, Tb6 As Variant, Tb7 As Variant, Tb8 As Variant, Tb9 As Variant

T00 = Array("", "", "deux ", "trois ", "quatre ", "cinq ", "six ", "sept ", "huit ", "neuf ")

Tb0 = Array("", "un ", "deux ", "trois ", "quatre ", "cinq ", "six ", "sept ", "huit ", "neuf ")
Tb1 = Array("dix ", "onze ", "douze ", "treize ", "quatorze ", "quinze ", "seize ", "dix-sept ", "dix-huit ", "dix-neuf ")
Tb2 = Array("vingt ", "vingt-et-un ", "vingt-deux ", "vingt-trois ", "vingt-quatre ", "vingt-cinq ", "vingt-six ", "vingt-sept ", "vingt-huit ", "vingt-neuf ")
Tb3 = Array("trente ", "trente-et-un ", "trente-deux ", "trente-trois ", "trente-quatre ", "trente-cinq ", "trente-six ", "trente-sept ", "trente-huit ", "trente-neuf ")
Tb4 = Array("quarante ", "quarante-et-un ", "quarante-deux ", "quarante-trois ", "quarante-quatre ", "quarante-cinq ", "quarante-six ", "quarante-sept ", "quarante-huit ", "quarante-neuf ")
Tb5 = Array("cinquante ", "cinquante-et-un ", "cinquante-deux ", "cinquante-trois ", "cinquante-quatre ", "cinquante-cinq ", "cinquante-six ", "cinquante-sept ", "cinquante-huit ", "cinquante-neuf ")
Tb6 = Array("soixante ", "soixante-et-un ", "soixante-deux ", "soixante-trois ", "soixante-quatre ", "soixante-cinq ", "soixante-six ", "soixante-sept ", "soixante-huit ", "soixante-neuf ")
Tb7 = Array("soixante-dix ", "soixante-et-onze ", "soixante-douze ", "soixante-treize ", "soixante-quatorze ", "soixante-quinze ", "soixante-seize ", "soixante-dix-sept ", "soixante-dix-huit ", "soixante-dix-neuf ")
Tb8 = Array("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 ")
Tb9 = Array("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 ")

C = Tranche \ 100
If C <> 0 Then
If TrCent And CenTouRon And C <> 1 Then
Lib = Lib & T00(C) & "cents "
Else
Lib = Lib & T00(C) & "cent "
End If
End If
D1 = Tranche Mod 100
D = D1 \ 10
U = Tranche Mod 10

Select Case D
Case 0: Lib = Lib & Tb0(U)
Case 1: Lib = Lib & Tb1(U)
Case 2: Lib = Lib & Tb2(U)
Case 3: Lib = Lib & Tb3(U)
Case 4: Lib = Lib & Tb4(U)
Case 5: Lib = Lib & Tb5(U)
Case 6: Lib = Lib & Tb6(U)
Case 7: Lib = Lib & Tb7(U)
Case 8: Lib = Lib & Tb8(U)
Case 9: Lib = Lib & Tb9(U)
End Select
End Sub
il suffit de recopier integralement la macro de mon fichier
ci joint fichier qui m'a été proposé par un des membres du site ...si tu es satisfait remercies le site

 

[kdet]

Re : convertir les chiffre en lettre

Bonjour Analyseaux, bonjour le forum

Merci pour le macro et merci au forum

kdet

 

[Habitude]

Re : convertir les chiffre en lettre

a mettre dans A2

=Si(IsNumeric(A1);CTXT(A1);A1)