Conversion des nombres en lettres

Messages postés
14
Date d'inscription
dimanche 5 novembre 2006
Statut
Membre
Dernière intervention
1 mai 2008
- - Dernière réponse : gillardg
Messages postés
3288
Date d'inscription
jeudi 3 avril 2008
Statut
Membre
Dernière intervention
14 septembre 2014
- 2 août 2010 à 10:22
Bonjour tout le monde, S'il vous
plaît est ce qu'il y a quelqu'un qui pourrait me passer une fonction
qui permet de convertir les nombres en lettres !!!!!! je suis bloqué





Merci et bonne journée
Afficher la suite 

7 réponses

Messages postés
7401
Date d'inscription
mercredi 23 avril 2003
Statut
Membre
Dernière intervention
6 avril 2012
45
0
Merci
Salut,
tu veux dire passer de 100 à cent????? ou de 100 à C

@+: Ju£i?n
Pensez: Réponse acceptée
Commenter la réponse de jrivet
Messages postés
14
Date d'inscription
dimanche 5 novembre 2006
Statut
Membre
Dernière intervention
1 mai 2008
0
Merci
par exple:  250 euros donne Deux Cent Cinquante Euros
Commenter la réponse de mehdiyou
Messages postés
160
Date d'inscription
mercredi 24 novembre 2004
Statut
Membre
Dernière intervention
8 juillet 2008
0
Merci
Attention tu es prêt ...
c'est du vbscript mais tu dois pouvoir l'adapter comme tu veux :
' *****************************************************************************
' ConvertitLettres
' *****************************************************************************
Public Function ConvertitLettres(Nombre,ChMonnaie)
    Dim NomUnites
    Dim valeurs
    Dim chaine
    dim sVar
    'tableau((billion,milliard,million,millier,unité,décimale),(centaine,dizaine,unité))
    Dim strT ' lettres de chaque chiffre selon emplacement
    Dim intD ' indicateur si chiffre avant, règle grammaticale (DEUX CENTS, DEUX CENT CINQ)
    Dim intT ' chiffre selon emplacement
    Dim b ' pour les boucle de traitement
    Dim d ' indicateur de décimale
    Dim Dizaine
    Dim ln
    Dim Presence
    Dim LeTiret
    Dim LaRetenue
    Dim Resultat
    ReDim NomUnites(90)
    ReDim valeurs(5)
    ReDim chaine(5)
    'tableau((billion,milliard,million,millier,unité,décimale),(centaine,dizaine,unité))
    ReDim strT(5, 2) ' lettres de chaque chiffre selon emplacement
    ReDim intD(5, 2) ' indicateur si chiffre avant, règle grammaticale (DEUX CENTS, DEUX CENT CINQ)
    ReDim intT(5, 2)  ' chiffre selon emplacement
    ReDim Presence(5)


    ' 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 NomUnites
    NomUnites(0) = "zéro"
    NomUnites(1) = "un"
    NomUnites(2) = "deux"
    NomUnites(3) = "trois"
    NomUnites(4) = "quatre"
    NomUnites(5) = "cinq"
    NomUnites(6) = "six"
    NomUnites(7) = "sept"
    NomUnites(8) = "huit"
    NomUnites(9) = "neuf"


    ' Initialisation des termes de la dizaine
    NomUnites(10) = "dix"
    NomUnites(11) = "onze"
    NomUnites(12) = "douze"
    NomUnites(13) = "treize"
    NomUnites(14) = "quatorze"
    NomUnites(15) = "quinze"
    NomUnites(16) = "seize"
    NomUnites(17) = "dix-sept"
    NomUnites(18) = "dix-huit"
    NomUnites(19) = "dix-neuf"


    ' Initialisation des termes de dizaines
    NomUnites(20) = "vingt"
    NomUnites(30) = "trente"
    NomUnites(40) = "quarante"
    NomUnites(50) = "cinquante"
    NomUnites(60) = "soixante"
    NomUnites(70) = "soixante"
    NomUnites(80) = "quatre-vingt"
    NomUnites(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 intT(b \ 3, b Mod 3) <> 0 then
           sVar = b + 1
        else
           sVar = intD(b \ 3, b Mod 3)
        end if
        If (b <> ln - 1) And b > 3 Then intD((b + 1) \ 3, (b + 1) Mod 3) = sVar
    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
            Presence(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
               if intD(b, 2) <> 0 Then
                  sVar = ""
               else
                  sVar = "s"
               end if
                strT(b, 2) = NomUnites(intT(b, 2)) + " cent" + sVar
            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               if intT(b, 1) 8 And intD(b, 1) 0 then
                  sVar = "s"
               else
                  sVar = ""
               end if
                strT(b, 1) = NomUnites(intT(b, 1) * 10) + sVar
                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) + " " + NomUnites(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 " + NomUnites(intT(b, 0) + LaRetenue * 10)
                    Else
                        strT(b, 0) = "-" + NomUnites(intT(b, 0) + LaRetenue * 10)
                    End If
                ElseIf b <> 2 Then
                    strT(b, 0) = NomUnites(intT(b, 0) + LaRetenue * 10)
                    ElseIf intT(b, 0) <> 1 Then strT(b, 0) = " " + NomUnites(intT(b, 0) + LaRetenue * 10)
                End If
            End If
            ' concatenation des centaines, dizaines et unités et retrait des espaces inutiles
            if strT(b, 1) = "" then
               sVar = ""
            else
               sVar = " "
            end if
            chaine(b) = Trim(Trim(strT(b, 2)) + sVar + Trim(strT(b, 1)))
            if Left(strT(b, 0), 1) = "-" then
               sVar = ""
            else
               sVar = " "
            end if
            chaine(b) = trim(chaine(b) + sVar + Trim(strT(b, 0)))
'            + IIf(Left(strT(b, 0), 1) = "-", "", " ") +
            ' ajout de la valeurs si > 1 et différent des Mille (invariable)
            if (Presence(b) > 1) And (b > 2) then 'IIf((Presence(b) > 1) And (b > 2), "s", "")
                sVar = "s"
            else
                sVar =""
            end if
            chaine(b) = chaine(b) + valeurs(b) + sVar
        End If
    Next


    ' concatenation finale et retrait des espaces inutiles
    Resultat = chaine(5)
    For b = 4 To 1 Step -1
        if chaine(b) <> "" then 'IIf(chaine(b) <> "", " ", "")
           sVar = " "
        else
           sVar = ""
        end if
        Resultat = Resultat + sVar + chaine(b)
    Next    If Resultat "" Then Resultat "zéro"
    if INSTR(1,Nombre,",")>0 then
        if Mid(Nombre, INSTR(1,Nombre,",")+1)*1 > 1 then 'IIf(CDec(Mid(Nombre, 1, Len(Nombre) - 3)) > 1, "s", "")
           sVar = "s"
        else
           sVar = ""
        end if
    else
        sVar = ""
    end if    If ChMonnaie True Then Resultat Resultat + " Euro" + sVar
    If chaine(0) <> "" Then
        Resultat = Resultat + " et " + chaine(0)
        if Presence(0) > 1 Then 'IIf(Presence(0) > 1, "s", "")
           sVar = "s"
        else
           sVar = ""
        end if        If ChMonnaie True Then Resultat Resultat + " centime" + sVar
    End If
    ' Fin
    ConvertitLettres = Trim(UCase(Resultat))
End Function

Cramsoturf le VBien en quête de nouveau programme
Commenter la réponse de Cramfr
Messages postés
2
Date d'inscription
mardi 16 septembre 2008
Statut
Membre
Dernière intervention
1 août 2010
0
Merci
bonjour tous le monde, voilà j suis tombé sur le même problème j'ai développer une application avec vb.net 2008 et dans crystal report je voudrais une fonction qui permet de convertir un montant en toutes lettres et je c pas comment faire et quelles sont les modification que je dois faire sur celle-ci je crois qu'elle fonctionne sur vb6.
si vous pouvez m'aider s'il vous plais je suis une débutante et je ss vraiment bloqué.
merci d'avance et bonne journée
Commenter la réponse de fleu2ra
Messages postés
540
Date d'inscription
mardi 4 août 2009
Statut
Membre
Dernière intervention
1 février 2013
1
0
Merci
Voici une autre fonction tirée du site qui peut aider:
    Public Function ConvNumToAlpha(ByVal Nombre As Double, ByVal Def_EUR__ID1_CHF__ID2_CAD As Double) As String
        ' MAJ: http://www.vbfrance.com/codes/TRADUIRE-GROS-CHIFFRES-LETTRES-AVEC-CORRECTION-ORTOGRAPHIQUE_47934.aspx
        ' Supporte plusieures devises ainsi que des nombres jusqu'aux quadrillions
        ' Tout est dans cette fonction, il n'est pas nécessaire de faire des déclarations au niveau du module
        Dim sFormat As String, sTraducteur As String, Chiffre As Integer, ChiffreMem As Integer
        Dim I As Integer, X As Integer, sAtome As String, S As String, Group As Integer, GroupMem As Integer
        Static CENTAINNES, DIZAINNES, UNITES, DIVERS, PARTICULIER
        Static devise, CouranteDevise As Integer, Updated As Boolean
        '
        If CouranteDevise <> Def_EUR__ID1_CHF__ID2_CAD Then
            Updated = False 'changement de divise, on doit alors re-initialiser les variables statiques
            CouranteDevise = Def_EUR__ID1_CHF__ID2_CAD
        End If
        If Not Updated Then 'afin d'économiser le CPU, les tableaux suivants sont mis à jour seulement quand nécessaire
            Updated = True
            'DEVISE = Split(" Euro, Franc, Dollar", ",")
            UNITES = Split(", un, deux, trois, quatre, cinq, six, sept, huit, neuf, dix, onze, douze, treize, quatorze, quinze, seize, dix-sept, dix-huit, dix-neuf", ",")
            DIZAINNES = Split(", dix, vingt, trente, quarante, cinquante, soixante, soixante-dix, quatre-vingt, quatre-vingt-dix", ",")
            CENTAINNES = Split(", cent, deux cent, trois cent, quatre cent, cinq cent, six cent, sept cent, huit cent, neuf cent", ",")
            PARTICULIER = Split(Chr(71) & Chr(80) & Chr(81) & ", soixante et onze, quatre-vingts, quatre-vingt-un", ",")
            'DIVERS = Split("MmiBbTQ., mille, million, milliard, billion, billiard, trillion, quadrillion, Euro ", ",")
            DIVERS = Split("MmiBbTQ., mille, million, milliard, billion, billiard, trillion, quadrillion,", ",")

            If CouranteDevise Then  'Francs suisses, Dollars canadians
                DIZAINNES(7) " septante" : DIZAINNES(8) " huitante" : DIZAINNES(9) = " nonante"
                ReDim PARTICULIER(0)
            End If
        End If
        On Error GoTo Fin
        '-------------------------------------CDUQCDUTCDUbCDUBCDUiCDUmCDUMCDU.DU-----------------------------
        sFormat = Trim(Format$(CDec(Nombre), "### ### ### ### ### ### ### ###.00")) ' Traduire notre nombre au format
        sTraducteur = Right$("CDUQCDUTCDUbCDUBCDUiCDUmCDUMCDU.DU", Len(sFormat))    ' compatible avec 'sTraducteur'
        'Text3 = sFormat
        If Int(Nombre) 0 Then S "Zéro"
        Group = 2
        X = InStr(sFormat, " ")
        If X Then Group = Val(Mid(sFormat, 1, X))
        For I = 1 To Len(sFormat)
            Chiffre = Val(Mid$(sFormat, I, 1))
            sAtome = Mid$(sTraducteur, I, 1)
            Select Case sAtome
                Case "U" ' les unités
                    If Group 1 And Mid(sTraducteur, I + 1, 1) "M" Then ' éviter les 'Un mille'
                    ElseIf Chiffre = 1 And ChiffreMem > 0 Then ' vingt et un, trente et un
                        S = S & " et" & UNITES(Chiffre)
                    ElseIf Chiffre > 1 And ChiffreMem > 0 Then ' vingt-deux, trente-trois
                        S = S & "-" & LTrim(UNITES(Chiffre))
                    ElseIf Chiffre Then
                        If Mid(sFormat, I + 1, 1) "." And GroupMem 0 And Nombre > 1000 Then S = S & " et"
                        S = S & UNITES(Chiffre)
                    End If
                Case "D" ' les dizainnes
                    X = InStr(PARTICULIER(0), Chr(Val(Mid$(sFormat, I, 2))))
                    If X Then 'soixante et onze, quatre-vingts, quatre-vingt-un
                        S = S & PARTICULIER(X)
                        I = I + 1 'éviter les prochainnes unités
                    ElseIf CouranteDevise = 0 And InStr("79", CStr(Chiffre)) > 0 And Val(Mid$(sFormat, I + 1, 1)) > 0 Then
                        S = S & DIZAINNES(Chiffre - 1)
                        I = I + 1 'éviter les prochainnes unités
                        ChiffreMem = Chiffre
                        Chiffre = Val(Mid$(sFormat, I, 1))
                        If ChiffreMem = 1 Then ' onze, douze
                            S = S & UNITES(Chiffre + 10)
                        Else ' soixante-onze, quatre-vingt-douze
                            S = S & "-" & LTrim(UNITES(Chiffre + 10))
                        End If
                    ElseIf Chiffre = 1 Then
                        S = S & UNITES(Val(Mid$(sFormat, I + 1, 1) + 10))
                        I = I + 1
                    ElseIf Chiffre Then
                        S = S & DIZAINNES(Chiffre)
                    End If
                Case "C" ' les centainnes
                    GroupMem = Group
                    Group = Val(Mid(sFormat, I, 3))
                    If Chiffre Then
                        S = S & CENTAINNES(Chiffre)
                        If Mid$(sFormat, I + 1, 3) = "00." And Chiffre > 1 Then
                            S S & "s" 'pluriel sur les centainnes: 600 six cents, 601= six cent un
                        End If
                    End If
                Case Else
                    X = InStr(DIVERS(0), sAtome)
                    If X > 0 And Group > 0 Then
                        S = S & DIVERS(X)
                        If Group > 1 And InStr("miBbTQ", sAtome) > 0 Then
                            S = S & "s" ' traiter les pluriels de million, milliard et billion
                        End If
                    ElseIf sAtome = "." Then
                        S = S & DIVERS(X)
                    End If
            End Select
            ChiffreMem = Chiffre ' mémoriser ce dernier chiffre
        Next
        ConvNumToAlpha = UCase(Mid(S, 1, 1)) & Mid(S, 2) ' mettre première lettre en majuscules
        Exit Function
Fin:
        If Len(Trim(Nombre)) Then MsgBox(Err.Description, vbCritical + vbSystemModal)
    End Function


Adapte la à ta manière...bonne rejouissance

Ce qui compte,ce n'est pas ce qu'on a mais plutôt ce que l'on fait avec ce qu'on a...
Visual Basic .Net is the best and vb6.0
Commenter la réponse de NSUADI
Messages postés
2
Date d'inscription
mardi 16 septembre 2008
Statut
Membre
Dernière intervention
1 août 2010
0
Merci
merci infiniment Mr NSUADI (y) j v essayer de l'adapter...j'éspére que ca marche correctement
Commenter la réponse de fleu2ra
Messages postés
3288
Date d'inscription
jeudi 3 avril 2008
Statut
Membre
Dernière intervention
14 septembre 2014
3
0
Merci
Bonjour,

en cherchant sur vbfrance j'ai trouvé ceci

http://www.vbfrance.com/code.aspx?ID=5511


a+
google est mon ami quand tu cherches quelque chose demande lui clairement
Commenter la réponse de gillardg