Sujet Précédent Sujet Suivant

TRANSFORMER UN CHIFFRE EN LETTRE EX: 110 => Cent Dix

Orbite - 6 sept. 2000 à 03:10
mahmoudkha2001 Messages postés 1 Date d'inscription vendredi 8 décembre 2006 Statut Membre Dernière intervention 9 avril 2009 - 9 avril 2009 à 10:34
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.

https://codes-sources.commentcamarche.net/source/83-transformer-un-chiffre-en-lettre-ex-110-cent-dix
mahmoudkha2001 Messages postés 1 Date d'inscription vendredi 8 décembre 2006 Statut Membre Dernière intervention 9 avril 2009
9 avril 2009 à 10:34
10/10
BRAVO
et merci
psy460 Messages postés 10 Date d'inscription mercredi 14 janvier 2009 Statut Membre Dernière intervention 24 avril 2009
2 févr. 2009 à 22:40
ah nan en faite j'ai pas bien vu mais l'algo il déchire tout ^^ mdr
psy460 Messages postés 10 Date d'inscription mercredi 14 janvier 2009 Statut Membre Dernière intervention 24 avril 2009
2 févr. 2009 à 20:51
l'algorithme est un peu améliorable (je l'ai en pascal si ça intéresse quelqu'un : psy4_60@hotmail.fr ^^) sinon très beau programme très pratique, il faudrait le mettre en dll
salu18 Messages postés 3 Date d'inscription mercredi 22 novembre 2000 Statut Membre Dernière intervention 23 juillet 2005
23 juil. 2005 à 13:04
bonjour
je cherche a transfer les chiffre en lettre sur access
merci d'avance
mon e'mail : etresolo@yahoo.fr
renaudf Messages postés 1 Date d'inscription mardi 14 juin 2005 Statut Membre Dernière intervention 16 juin 2005
16 juin 2005 à 10:45
voici le code très légerement modifié qui compile avec .NET et qui resout le cas "1000". Le script indiquait en effet "un mille" au lieu de "mille".
merci en tout cas pour ce script.

-----------------
Imports Microsoft.VisualBasic

Public Module Utils

Public Function Nombre2Texte(ByVal ValNum As Double) As String
Static Unites(9) As String
Static Dixaines(9) As String
Static LesDixaines(9) As String
Static Milliers(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))

If ValNum 0 Or ValNum 1 Then
strResultat = Unites(ValNum)
End If

If ValNum = 1000
Return Milliers(1)
End If

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
If ValNb = 1 Then
tmpBuff = LesDixaines(6) & " et " & Dixaines(ValNb) & " "
Else
tmpBuff = LesDixaines(6) & " " & Dixaines(ValNb) & " "
End If
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
If strResultat = "un " And ValNb <> 8 Then
strResultat = LesDixaines(ValNb) & " et " & strResultat
Else
strResultat = LesDixaines(ValNb) & " " & strResultat
End If
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:
Nombre2Texte = strResultat
Exit Function

NbVersTexteError:
Nombre2Texte = "!! Erreur !!"
Resume EndNbVersTexte
End Function

End Module
jamil0001 Messages postés 5 Date d'inscription mardi 1 février 2005 Statut Membre Dernière intervention 5 septembre 2006
14 avril 2005 à 16:37
10/10
BRAVO
et merci
lyju Messages postés 7 Date d'inscription vendredi 22 octobre 2004 Statut Membre Dernière intervention 18 novembre 2009
22 nov. 2004 à 13:48
Petit détail. Dans la déclaration de la fonction, tu mets "ByVal ValNum As Double". Petit souci si la conversion auto ne peut pas se faire, par exemple avec du texte. Et ca se niveau le 'On Error' ne peut pas grand chose.

De plus a la ligne :
strTemp = CStr(Int(ValNum))

Pourquoi le mettre en double, le caster en Int, puis le retransformer en chaine de caractère... Alors qu'a la base une simple "ByVal ValNum As String" aurait directement suffit. Avec la pour le coup un petit test numérique avec message d'erreur :

If (IsNumeric(ValNum)) Then

strTemp = ValNum
(...suite et fin du code...)
else
Messagebox.show("veuillez entrer un nombre entier")
end if

On peu complexifier le test si l'on veut aussi exclure les chiffre à virgules...

Voila, bon ptit code tout de meme
econs Messages postés 4030 Date d'inscription mardi 13 mai 2003 Statut Membre Dernière intervention 23 décembre 2008 24
1 nov. 2004 à 21:40
Marrant çà. Aujourd'hui, ce genre de code ne serait pas estampillé "Expert", mais plutot "Débutant".

Comme quoi, tout évolue sur VBFrance.
cs_monfre Messages postés 2 Date d'inscription dimanche 12 septembre 2004 Statut Membre Dernière intervention 12 septembre 2004
12 sept. 2004 à 15:56
Il reste une dernière chose à faire pour que ce code soit parfait : ajouter des tirets aux nombre composés. Normalement on devrait avoir des tirets entre chaque partie du nombre pour tous les nombres compris entre 17 et 99 (99 doit s'écrire "quatre-vingt-dix-neuf" et non pas "quatre-vingt dix-neuf" comme s'est le cas actuellement).

Mais je ne sais pas comment faire...
cs_monfre Messages postés 2 Date d'inscription dimanche 12 septembre 2004 Statut Membre Dernière intervention 12 septembre 2004
12 sept. 2004 à 15:51
Bonjour,

Voici une modification du code pour écrire "1 000 000", "un million" et non pas "million" seulement.

En tout cas merci à celui qui est à l'origine de ce code.

Public Function NbVersTexte(ByVal 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))

If ValNum 0 Or ValNum 1 Then
strResultat = Unites(ValNum)
End If

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
If ValNb = 1 Then
tmpBuff = LesDixaines(6) & " et " & Dixaines(ValNb) & " "
Else
tmpBuff = LesDixaines(6) & " " & Dixaines(ValNb) & " "
End If
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
If strResultat = "un " And ValNb <> 8 Then
strResultat = LesDixaines(ValNb) & " et " & strResultat
Else
strResultat = LesDixaines(ValNb) & " " & strResultat
End If
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
cs_bozos Messages postés 3 Date d'inscription jeudi 21 août 2003 Statut Membre Dernière intervention 28 novembre 2003
28 nov. 2003 à 09:15
Bonjours,

Je voulais simplement vous remercier pour votre aide, ce code fonctionne très bien, je crois que je vous doit une fière chandelle.
Merci encore.
cs_bozos Messages postés 3 Date d'inscription jeudi 21 août 2003 Statut Membre Dernière intervention 28 novembre 2003
28 nov. 2003 à 08:38
Bonjours,
Votre code de transformation de chiffres en lettre m'intéresse bcoup, seulement je ne sais pas s'il ne serai pas possible d'en faire un fichier DLL afin de l'utiliser dans n'importe quelle application sans avoir à remodifier quoi que ce soit. Sans oublier bien sur de spécifier pour la DLL le point d'entrer c'est à dire la fonction à appeler.
Merci encore pour votre concour.
superden Messages postés 3 Date d'inscription samedi 26 janvier 2002 Statut Membre Dernière intervention 26 janvier 2002
26 janv. 2002 à 14:46
dans ton fichier où le Form1 dans

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

corrige la pour

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

mais a par sa c cool ton truc!!!
seb
18 sept. 2001 à 11:11
Voici le code après quelques modifs pour gérer "vingt et un" (jusqu'à 81), "zéro" et "un"

Public Function NbVersTexte(ByVal 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))

If ValNum 0 Or ValNum 1 Then
strResultat = Unites(ValNum)
End If

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
If ValNb = 1 Then
tmpBuff = LesDixaines(6) & " et " & Dixaines(ValNb) & " "
Else
tmpBuff = LesDixaines(6) & " " & Dixaines(ValNb) & " "
End If
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
If strResultat = "un " And ValNb <> 8 Then
strResultat = LesDixaines(ValNb) & " et " & strResultat
Else
strResultat = LesDixaines(ValNb) & " " & strResultat
End If
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
kerigan
22 août 2001 à 18:16
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 ???
marchristian
7 août 2001 à 13:30
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
Fred
8 mars 2001 à 09:42
Trés bien, Merci !
Orbite
6 sept. 2000 à 03:27
(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
Orbite
6 sept. 2000 à 03:10
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

Discussions similaires

ecriture littérale d'un chiffre en lettre arabe
bocheta1966 -
cs_Korda -

7 réponses
conversion chiffre en lettre
davidbig -
smarticu -

2 réponses
Convertir Chiffres en lettres
cs_slim59 -
khalidsami -

3 réponses
lettre aléatoire
Thanos_the_yopper -
Thanos_the_yopper -

3 réponses
Ascii conversion chiffre <=> lettre
deetsrider -
Whismeril -

6 réponses
Rejoignez-nous