Conversion des nombres en lettres

Question

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

jrivet · Answer

Salut,
tu veux dire passer de 100 à cent????? ou de 100 à C

@+: Ju£i?n
Pensez: Réponse acceptée

mehdiyou · Answer

par exple:  250 euros donne Deux Cent Cinquante Euros

Cramfr · Answer

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

fleu2ra · Answer

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

NSUADI · Answer

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

fleu2ra · Answer

merci infiniment Mr NSUADI (y) j v essayer de l'adapter...j'éspére que ca marche correctement

gillardg · Answer

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

Conversion des nombres en lettres

7 réponses

Votre réponse

Discussions similaires