Convertir des chiffres en lettres avec ou sans décimale et/ou monétaire

Télécharger le projet
Commenter

Description

je sais qu'il en existe déjà plusieurs mais celui-ci n'utilise
qu'une boucle de traitement (centaine, dizaine et unité)

permet de convertir des nombres en lettres
de 0,01 à 999999999999999,99 (1 billiard - 0,01)
avec ou sans indicateur monétaire
p.s. : le séparateur de décimales est la virgule et non le point

si vous avez besoin de plus grand encore
vous n'avez qu'à redimensionner les tables

vous pouvez changer aussi l'indicateur monétaire selon votre pays

Source / Exemple : 


' Renvoie un nombre sous forme de lettres ( 3581 devient TROIS MILLE CINQ CENT QUATRE-VINGT-UN)
Public Function ConvertitLettres2(Nombre As String) As String
    Dim NomUnités(90) As String
    Dim valeurs(5) As String, chaine(5) As String
    'tableau((billion,milliard,million,millier,unité,décimale),(centaine,dizaine,unité))
    Dim strT(5, 2) As String    ' lettres de chaque chiffre selon emplacement
    Dim intD(5, 2) As Integer   ' indicateur si chiffre avant, règle grammaticale (DEUX CENTS, DEUX CENT CINQ)
    Dim intT(5, 2) As Integer   ' chiffre selon emplacement
    Dim b As Integer    ' pour les boucle de traitement
    Dim d As Integer    ' indicateur de décimale
    Dim Dizaine As Integer, ln As Integer
    Dim Présence(5) As Integer
    Dim LeTiret As Boolean, LaRetenue As Integer
    Dim Résultat As String
    
    ' Initialisation de valeurs
    valeurs(5) = " billion"
    valeurs(4) = " milliard"
    valeurs(3) = " million"
    valeurs(2) = " mille"
    valeurs(1) = "" ' unité
    valeurs(0) = "" ' décimale
    
    ' Initialisation des termes de NomUnités
    NomUnités(0) = "zéro"
    NomUnités(1) = "un"
    NomUnités(2) = "deux"
    NomUnités(3) = "trois"
    NomUnités(4) = "quatre"
    NomUnités(5) = "cinq"
    NomUnités(6) = "six"
    NomUnités(7) = "sept"
    NomUnités(8) = "huit"
    NomUnités(9) = "neuf"
    
    ' Initialisation des termes de la dizaine
    NomUnités(10) = "dix"
    NomUnités(11) = "onze"
    NomUnités(12) = "douze"
    NomUnités(13) = "treize"
    NomUnités(14) = "quatorze"
    NomUnités(15) = "quinze"
    NomUnités(16) = "seize"
    NomUnités(17) = "dix-sept"
    NomUnités(18) = "dix-huit"
    NomUnités(19) = "dix-neuf"
    
    ' Initialisation des termes de dizaines
    NomUnités(20) = "vingt"
    NomUnités(30) = "trente"
    NomUnités(40) = "quarante"
    NomUnités(50) = "cinquante"
    NomUnités(60) = "soixante"
    NomUnités(70) = "soixante"
    NomUnités(80) = "quatre-vingt"
    NomUnités(90) = "quatre-vingt"
    
    ' Classification du nombre en sous-unités
    d = InStr(1, Nombre, ",")   ' nombre entier ou avec décimale
    If d Then
        Nombre = Left(Nombre, d - 1) + "0" + Mid(Nombre, d + 1) ' remplace la virgule par zéro
        If Len(Nombre) - d = 1 Then Nombre = Nombre + "0"        's'assure qu'il y a 2 décimales
        If Len(Nombre) - d > 2 Then         ' sinon on arrondit à 2 décimales
            If Mid(Nombre, d + 3, 1) >= 5 Then
                Nombre = Mid(Nombre, 1, d + 1) & (1 + Mid(Nombre, d + 2, 1))
                Nombre = Mid(Nombre, 1, d + 2)
            Else
                Nombre = Mid(Nombre, 1, d + 2)
            End If
        End If
    Else
        Nombre = Nombre + "000"     'sinon on ajoute pour combler les décimales
    End If
    intD(0, 0) = 0
    ln = Len(Nombre)
    For b = 0 To ln - 1
        intT(b \ 3, b Mod 3) = Mid(Nombre, ln - b, 1)
        If (b <> ln - 1) And b > 3 Then intD((b + 1) \ 3, (b + 1) Mod 3) = IIf(intT(b \ 3, b Mod 3) <> 0, b + 1, intD(b \ 3, b Mod 3))
    Next
    ' Recherche des termes adaptés à chaque sous-unité
    For b = (ln \ 3 + ln Mod 3) - 1 To 0 Step -1
        strT(b, 0) = ""
        chaine(b) = ""
        LeTiret = False
        LaRetenue = 0
        If intT(b, 2) * 100 + intT(b, 1) * 10 + intT(b, 0) <> 0 Then
            ' Activation du drapeau
            Présence(b) = intT(b, 2) * 100 + intT(b, 1) * 10 + intT(b, 0)
            ' Nombre supérieur ou égal à 1
            ' Vérification si supérieur ou égale à 100
            If intT(b, 2) >= 2 Then
                strT(b, 2) = NomUnités(intT(b, 2)) + " cent" + IIf(intD(b, 2) <> 0, "", "s")
            ElseIf intT(b, 2) = 1 Then
                strT(b, 2) = "cent"
            End If
            Dizaine = intT(b, 1) * 10 + intT(b, 0)
            ' Vérification si supérieur à 20
            If Dizaine >= 20 Then
                strT(b, 1) = NomUnités(intT(b, 1) * 10) + IIf(intT(b, 1) = 8 And intD(b, 1) = 0, "s", "")
                If Dizaine >= 60 Then
                    LaRetenue = ((Dizaine \ 10) - 6) Mod 2
                End If
                LeTiret = True
            ElseIf Dizaine >= 10 And Dizaine <= 19 Then
                strT(b, 1) = strT(b, 1) + " " + NomUnités(Dizaine)
            End If
            ' Vérification si unité non-nul
            If (intT(b, 0) > 0 And intT(b, 1) <> 1) Or LaRetenue Then 'Dizaine <> 1 Then
                If LeTiret And intT(b, 1) <> 1 Then
                    If intT(b, 0) = 1 And intT(b, 1) < 8 Then
                        strT(b, 0) = " et " + NomUnités(intT(b, 0) + LaRetenue * 10)
                    Else
                        strT(b, 0) = "-" + NomUnités(intT(b, 0) + LaRetenue * 10)
                    End If
                ElseIf b <> 2 Then
                    strT(b, 0) = NomUnités(intT(b, 0) + LaRetenue * 10)
                    ElseIf intT(b, 0) <> 1 Then strT(b, 0) = " " + NomUnités(intT(b, 0) + LaRetenue * 10)
                End If
            End If
            ' concatenation des centaines, dizaines et unités et retrait des espaces inutiles
            chaine(b) = Trim(Trim(strT(b, 2)) + IIf(strT(b, 1) = "", "", " ") + Trim(strT(b, 1)) + IIf(Left(strT(b, 0), 1) = "-", "", " ") + Trim(strT(b, 0)))
            ' ajout de la valeurs si > 1 et différent des Mille (invariable)
            chaine(b) = chaine(b) + valeurs(b) + IIf((Présence(b) > 1) And (b > 2), "s", "")
        End If
    Next
    
    ' concatenation finale et retrait des espaces inutiles
    Résultat = chaine(5)
    For b = 4 To 1 Step -1
        Résultat = Résultat + IIf(chaine(b) <> "", " ", "") + chaine(b)
    Next
    If Résultat = "" Then Résultat = "zéro"
    If ChMonnaie = vbChecked Then Résultat = Résultat + " dollar" + IIf(CDec(Mid(Nombre, 1, Len(Nombre) - 3)) > 1, "s", "")
    If chaine(0) <> "" Then
        Résultat = Résultat + " et " + chaine(0)
        If ChMonnaie = vbChecked Then Résultat = Résultat + " cent" + IIf(Présence(0) > 1, "s", "")
    End If
    ' Fin
    ConvertitLettres2 = Trim$(UCase$(Résultat))
    Text2 = ConvertitLettres2
End Function

Conclusion :


mise a jour 1
il y a vérification du nombre de décimales.
1 décimale alors on ajout un zéro
plus de 2 décimales; arrondissement (ex. : 3,12499 = 3,12 et 3.1250001 = 3.13

mise a jour 2 (à venir)
indicateurs (70,80,90) et de monnaie selon pays
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_gandalf27)