Transformer un chiffre en lettre ex: 110 => cent dix

Soyez le premier à donner votre avis sur cette source.

Vue 119 893 fois - Téléchargée 13 719 fois


Télécharger le projet
Commenter

Description

Comment puis-je transformer un Nombre ( ex : 110 ) en toutes lettres ( ex : Cent dix ) ?

Créez un Formulaire avec 2 TextBox (Text1 et Text2) ainsi qu'un bouton (Command1)
Dans Text1 il y aura le Nombre (ex:110) et Dans Text2 le résultat (ex:Cent dix)

Mettez ce code dans un Module :

Source / Exemple : 


Public Function NbVersTexte(ValNum As Double) As String
    Static Unites(0 To 9) As String
    Static Dixaines(0 To 9) As String
    Static LesDixaines(0 To 9) As String
    Static Milliers(0 To 4) As String
    
    Dim i As Integer
    Dim nPosition As Integer
    Dim ValNb As Integer
    Dim LesZeros As Integer
    Dim strResultat As String
    Dim strTemp As String
    Dim tmpBuff As String
    
    Unites(0) = "zero"
    Unites(1) = "un"
    Unites(2) = "deux"
    Unites(3) = "trois"
    Unites(4) = "quatre"
    Unites(5) = "cinq"
    Unites(6) = "six"
    Unites(7) = "sept"
    Unites(8) = "huit"
    Unites(9) = "neuf"

    Dixaines(0) = "dix"
    Dixaines(1) = "onze"
    Dixaines(2) = "douze"
    Dixaines(3) = "treize"
    Dixaines(4) = "quatorze"
    Dixaines(5) = "quinze"
    Dixaines(6) = "seize"
    Dixaines(7) = "dix-sept"
    Dixaines(8) = "dix-huit"
    Dixaines(9) = "dix-neuf"

    LesDixaines(0) = ""
    LesDixaines(1) = "dix"
    LesDixaines(2) = "vingt"
    LesDixaines(3) = "trente"
    LesDixaines(4) = "quarante"
    LesDixaines(5) = "cinquante"
    LesDixaines(6) = "soixante"
    LesDixaines(7) = "soixante-dix"
    LesDixaines(8) = "quatre-vingt"
    LesDixaines(9) = "quatre-vingt-dix"

    Milliers(0) = ""
    Milliers(1) = "mille"
    Milliers(2) = "million"
    Milliers(3) = "millard"
    Milliers(4) = "mille"

    On Error GoTo NbVersTexteError
    
    strTemp = CStr(Int(ValNum))
    
    For i = Len(strTemp) To 1 Step -1
        ValNb = Val(Mid$(strTemp, i, 1))
        nPosition = (Len(strTemp) - i) + 1
        Select Case (nPosition Mod 3)
            Case 1
                LesZeros = False
                If i = 1 Then
                    If ValNb > 1 Then
                        tmpBuff = Unites(ValNb) & " "
                    Else
                        tmpBuff = ""
                    End If
                ElseIf Mid$(strTemp, i - 1, 1) = "1" Then
                    tmpBuff = Dixaines(ValNb) & " "
                    i = i - 1
                ElseIf Mid$(strTemp, i - 1, 1) = "9" Then
                    tmpBuff = LesDixaines(8) & " " & Dixaines(ValNb) & " "
                    i = i - 1
                ElseIf Mid$(strTemp, i - 1, 1) = "7" Then
                    tmpBuff = LesDixaines(6) & " " & Dixaines(ValNb) & " "
                    i = i - 1
                ElseIf ValNb > 0 Then
                    tmpBuff = Unites(ValNb) & " "
                Else
                    LesZeros = True
                    If i > 1 Then
                        If Mid$(strTemp, i - 1, 1) <> "0" Then
                            LesZeros = False
                        End If
                    End If
                    If i > 2 Then
                        If Mid$(strTemp, i - 2, 1) <> "0" Then
                            LesZeros = False
                        End If
                    End If
                    tmpBuff = ""
                End If
                If LesZeros = False And nPosition > 1 Then
                    tmpBuff = tmpBuff & Milliers(nPosition / 3) & " "
                End If
                strResultat = tmpBuff & strResultat
            Case 2
                If ValNb > 0 Then
                            strResultat = LesDixaines(ValNb) & " " & strResultat
                End If
            Case 0
                If ValNb > 0 Then
                    If ValNb > 1 Then
                        strResultat = Unites(ValNb) & " cent " & strResultat
                    Else
                        strResultat = "cent " & strResultat
                    End If
                End If
        End Select
    Next i
    If Len(strResultat) > 0 Then
        strResultat = UCase$(Left$(strResultat, 1)) & Mid$(strResultat, 2)
    End If

EndNbVersTexte:
    NbVersTexte = strResultat
    Exit Function

NbVersTexteError:
    strResultat = "Une Erreur !"
    Resume EndNbVersTexte
End Function

' Puis pour l'utiliser mettez ce code dans votre Formulaire

Private Sub Command1_Click()
    Text2.Text = NbVersTexte(Text1.Text)
End Sub

' N.B : Ce code à été adapté du code de Jim Youmans pour être utiliser en francais car les chiffres comme 75 et 95 ne s'affiche pas de la même façon.
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Signaler
-
pour utiliser ce fichier source il faut mettre ce code :

Private Sub Command1_Click()
Text2.Text = NbVersTexte(Text1.Text)
End Sub


a la place de :

Private Sub Command1_Click()
Text2.Text = NumToText(Text1.Text)
End Sub

sinon ça ne fonctionne pas !... :)

@micalement Orbite
Signaler
-
(ainsi que ce code : pour afficher 0 :"zero" et 1 "un"...)

Public Function NbVersTexte(ValNum As Double) As String
Static Unites(0 To 9) As String
Static Dixaines(0 To 9) As String
Static LesDixaines(0 To 9) As String
Static Milliers(0 To 4) As String

Dim i As Integer
Dim nPosition As Integer
Dim ValNb As Integer
Dim LesZeros As Integer
Dim strResultat As String
Dim strTemp As String
Dim tmpBuff As String

Unites(0) = "zero"
Unites(1) = "un"
Unites(2) = "deux"
Unites(3) = "trois"
Unites(4) = "quatre"
Unites(5) = "cinq"
Unites(6) = "six"
Unites(7) = "sept"
Unites(8) = "huit"
Unites(9) = "neuf"

Dixaines(0) = "dix"
Dixaines(1) = "onze"
Dixaines(2) = "douze"
Dixaines(3) = "treize"
Dixaines(4) = "quatorze"
Dixaines(5) = "quinze"
Dixaines(6) = "seize"
Dixaines(7) = "dix-sept"
Dixaines(8) = "dix-huit"
Dixaines(9) = "dix-neuf"

LesDixaines(0) = ""
LesDixaines(1) = "dix"
LesDixaines(2) = "vingt"
LesDixaines(3) = "trente"
LesDixaines(4) = "quarante"
LesDixaines(5) = "cinquante"
LesDixaines(6) = "soixante"
LesDixaines(7) = "soixante-dix"
LesDixaines(8) = "quatre-vingt"
LesDixaines(9) = "quatre-vingt-dix"

Milliers(0) = ""
Milliers(1) = "mille"
Milliers(2) = "million"
Milliers(3) = "millard"
Milliers(4) = "mille"

On Error GoTo NbVersTexteError

strTemp = CStr(Int(ValNum))

For i = Len(strTemp) To 1 Step -1
ValNb = Val(Mid$(strTemp, i, 1))
nPosition = (Len(strTemp) - i) + 1
Select Case (nPosition Mod 3)
Case 1
LesZeros = False
If i = 1 Then
If ValNb > 0 Then
tmpBuff = Unites(ValNb) & " "
Else
tmpBuff = "zero"
End If
ElseIf Mid$(strTemp, i - 1, 1) = "1" Then
tmpBuff = Dixaines(ValNb) & " "
i = i - 1
ElseIf Mid$(strTemp, i - 1, 1) = "9" Then
tmpBuff = LesDixaines(8) & " " & Dixaines(ValNb) & " "
i = i - 1
ElseIf Mid$(strTemp, i - 1, 1) = "7" Then
tmpBuff = LesDixaines(6) & " " & Dixaines(ValNb) & " "
i = i - 1
ElseIf ValNb > 0 Then
tmpBuff = Unites(ValNb) & " "
Else
LesZeros = True
If i > 1 Then
If Mid$(strTemp, i - 1, 1) <> "0" Then
LesZeros = False
End If
End If
If i > 2 Then
If Mid$(strTemp, i - 2, 1) <> "0" Then
LesZeros = False
End If
End If
tmpBuff = ""
End If
If LesZeros = False And nPosition > 1 Then
tmpBuff = tmpBuff & Milliers(nPosition / 3) & " "
End If
strResultat = tmpBuff & strResultat
Case 2
If ValNb > 0 Then
strResultat = LesDixaines(ValNb) & " " & strResultat
End If
Case 0
If ValNb > 0 Then
If ValNb > 1 Then
strResultat = Unites(ValNb) & " cent " & strResultat
Else
strResultat = "cent " & strResultat
End If
End If
End Select
Next i
If Len(strResultat) > 0 Then
strResultat = UCase$(Left$(strResultat, 1)) & Mid$(strResultat, 2)
End If

EndNbVersTexte:
NbVersTexte = strResultat
Exit Function

NbVersTexteError:
strResultat = "Une Erreur !"
Resume EndNbVersTexte
End Function
Signaler
-
Trés bien, Merci !
Signaler
-
Le même programme prenant en compte les décimales serait le bien venu (ex. convertir 825,52F en lettres). merci d'y penser car mes connaissances sont limitées.
@micalement
Signaler
-
Millard !!!!! Milliard
t'on application n'est pas correcte au niveau grammaire.
Elle n'est pas capable de traiter les chiffre décimaux. A tu quelque chose de plus costaud ???
Afficher les 19 commentaires
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 (Nix)