TRANSFORMER UN CHIFFRE EN LETTRE EX: 110 => Cent Dix
Orbite
-
6 sept. 2000 à 03:10
mahmoudkha2001
Messages postés1Date d'inscriptionvendredi 8 décembre 2006StatutMembreDerniè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.
mahmoudkha2001
Messages postés1Date d'inscriptionvendredi 8 décembre 2006StatutMembreDernière intervention 9 avril 2009 9 avril 2009 à 10:34
10/10
BRAVO
et merci
psy460
Messages postés10Date d'inscriptionmercredi 14 janvier 2009StatutMembreDernière intervention24 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és10Date d'inscriptionmercredi 14 janvier 2009StatutMembreDernière intervention24 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és3Date d'inscriptionmercredi 22 novembre 2000StatutMembreDernière intervention23 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és1Date d'inscriptionmardi 14 juin 2005StatutMembreDernière intervention16 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
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és5Date d'inscriptionmardi 1 février 2005StatutMembreDernière intervention 5 septembre 2006 14 avril 2005 à 16:37
10/10
BRAVO
et merci
lyju
Messages postés7Date d'inscriptionvendredi 22 octobre 2004StatutMembreDernière intervention18 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és4030Date d'inscriptionmardi 13 mai 2003StatutMembreDernière intervention23 décembre 200824 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és2Date d'inscriptiondimanche 12 septembre 2004StatutMembreDernière intervention12 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és2Date d'inscriptiondimanche 12 septembre 2004StatutMembreDernière intervention12 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
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és3Date d'inscriptionjeudi 21 août 2003StatutMembreDernière intervention28 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és3Date d'inscriptionjeudi 21 août 2003StatutMembreDernière intervention28 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és3Date d'inscriptionsamedi 26 janvier 2002StatutMembreDernière intervention26 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
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
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
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 ???
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
(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
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
9 avril 2009 à 10:34
BRAVO
et merci
2 févr. 2009 à 22:40
2 févr. 2009 à 20:51
23 juil. 2005 à 13:04
je cherche a transfer les chiffre en lettre sur access
merci d'avance
mon e'mail : etresolo@yahoo.fr
16 juin 2005 à 10:45
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
14 avril 2005 à 16:37
BRAVO
et merci
22 nov. 2004 à 13:48
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
1 nov. 2004 à 21:40
Comme quoi, tout évolue sur VBFrance.
12 sept. 2004 à 15:56
Mais je ne sais pas comment faire...
12 sept. 2004 à 15:51
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
28 nov. 2003 à 09:15
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.
28 nov. 2003 à 08:38
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.
26 janv. 2002 à 14:46
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!!!
18 sept. 2001 à 11:11
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
22 août 2001 à 18:16
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 ???
7 août 2001 à 13:30
@micalement
8 mars 2001 à 09:42
6 sept. 2000 à 03:27
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
6 sept. 2000 à 03:10
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