Demande d'aide

JaguarAquatique50 Messages postés 2 Date d'inscription   Statut Membre Dernière intervention   -  
JCB40 Messages postés 3480 Date d'inscription   Statut Membre Dernière intervention   -

Bonjour ! svp, pouvez-vous m'aider pour avoir la macro VBA Excel NBlettre pour convertir les nombres en lettre ?

Merci d'avance pour votre aide.

1 réponse

Réponse 1 / 1
JCB40 Messages postés 3480 Date d'inscription   Statut Membre Dernière intervention   470
 

Bonjour


    Ouvrez Excel.
    Appuyez sur ALT + F11 pour ouvrir l’éditeur VBA.
    Cliquez sur Insertion puis Module pour créer un nouveau module.
    Copiez et collez le code suivant dans le module :

Function NBlettre(ByVal Nombre As Double) As String
    Dim Unités As Variant
    Dim Dixièmes As Variant
    Dim Centaines As Variant
    Dim Milliers As Variant
    
    Unités = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf")
    Dixièmes = Array("", "dix", "vingt", "trente", "quarante", "cinquante", "soixante", "soixante-dix", "quatre-vingts", "quatre-vingt-dix")
    Centaines = Array("", "cent", "deux cents", "trois cents", "quatre cents", "cinq cents", "six cents", "sept cents", "huit cents", "neuf cents")
    Milliers = Array("", "mille", "deux mille", "trois mille", "quatre mille", "cinq mille", "six mille", "sept mille", "huit mille", "neuf mille")

    Dim Resultat As String
    Dim Unité As Integer
    Dim Dixième As Integer
    Dim Centaine As Integer
    Dim Millier As Integer
    
    ' Séparer les chiffres
    Millier = Int(Nombre / 1000)
    Centaine = Int((Nombre Mod 1000) / 100)
    Dixième = Int((Nombre Mod 100) / 10)
    Unité = Nombre Mod 10

    ' Construire le résultat
    If Millier > 0 Then Resultat = Resultat & Milliers(Millier) & " "
    If Centaine > 0 Then Resultat = Resultat & Centaines(Centaine) & " "
    
    ' Dixièmes et Unités
    If Dixième = 1 And Unité > 0 Then
        Resultat = Resultat & Dixièmes(Dixième) & " " & Unités(Unité + 10) & " "
    Else
        If Dixième > 0 Then Resultat = Resultat & Dixièmes(Dixième) & " "
        If Unité > 0 Then Resultat = Resultat & Unités(Unité) & " "
    End If
    
    NBlettre = Trim(Resultat)
End Function

0