Rechercher : dans
Par :

Chiffre en lettre

Dernière réponse le 22 sep 2008 à 18:35:04 tacha84, le 22 oct 2007 à 10:26:13 
 Signaler ce message aux modérateurs

Bonjour,
j'ai le code suivant écrit en VB,il permet de transformer un chiffre écrit en lettre par exemple:2560.36 il m'affiche deux millions cinq cent soixante dinar trois cent millimes.alor que moi je veux faire quelque modification pour qu'il m'affiche mille à la place de million,dinar elle devient dinar(s) et les premières lettre s'écrit en majuscule.donc il devient Deux Mille et Cinq Cent Soixante Dinar(s) et Trois Cent Soixante Millimes.
SVP c'est très très urgent.merci

Configuration: Windows XP
Firefox 2.0

Meilleures réponses pour « chiffre en lettre » dans :
[Word] Écrire un nombre en toutes lettres VoirPour transformer un nombre en toutes lettres sans se perdre dans l'orthographe (tirets, 's'...), il est possible de demander à Word de formater ce nombre en lettres : Créer un champ avec CTRL-F9 S'affichera {} à l'écran Le remplir avec la...
PHP - Code antispam avec chiffres et lettres (CAPTCHA) VoirSur de nombreux sites, dont CommentCaMarche, les formulaires sont accompagnés d'un encart demandant de recopier un code généré aléatoirement. Un tel système, appelé CAPTCHA, permet de limiter les envois abusifs automatisés (SPAMS). Les sites...
Chiffrement par substitution VoirLe chiffrement par substitution Le chiffrement par substitution consiste à remplacer dans un message une ou plusieurs entités (généralement des lettres) par une ou plusieurs autres entités. On distingue généralement plusieurs types de...

1

tacha84, le 22 oct 2007 à 10:29:42
  • +1

Ah j'ai oublié de vous dire que ce code est écrit sous excel

Répondre à tacha84

2

 tacha84, le 22 oct 2007 à 10:36:41
  • +16

Option Explicit

'---------------------------------------------
' Permet la conversion des valeurs en lettres
'---------------------------------------------
Function lireCentaine(ByVal Montant As Double) As String
Dim ChiffreLettre
Dim Centaine As Double
Dim Dizaine As Double
Dim T As String
Dim Chaine As String
'tableau de conversion des chiffres en texte
ChiffreLettre = Array("un", "deux", "trois", "quatre", "cinq", "six", _
"sept", "huit", "neuf", "dix", _
"onze", "douze", "treize", "quatorze", "quinze", _
"seize", "dix-sept", "dix-huit", "dix-neuf")
'recherche des centaines
Centaine = Int(Montant / 100)

Select Case Centaine
Case 0
Chaine = ""
Case 1
Chaine = "cent"
Case Else 'autres valeurs
Chaine = ChiffreLettre(Centaine - 1) & " cent"
End Select

Dizaine = Modulo(Montant, 100)
Select Case Dizaine
Case 0
T = ""
Case 1 To 19
T = ChiffreLettre(Dizaine - 1)
Case 20
T = "vingt"
Case 21
T = "vingt et un"
Case 22 To 29
T = "vingt " & ChiffreLettre(Dizaine - 21)
Case 30
T = "trente"
Case 31
T = "trente et un"
Case 32 To 39
T = "trente " & ChiffreLettre(Dizaine - 31)
Case 40
T = "quarante"
Case 41
T = "quarante et un"
Case 42 To 49
T = "quarante " & ChiffreLettre(Dizaine - 41)
Case 50
T = "cinquante"
Case 51
T = "cinquante et un"
Case 52 To 59
T = "cinquante " & ChiffreLettre(Dizaine - 51)
Case 60
T = "soixante"
Case 61
T = "soixante et un"
Case 62 To 69
T = "soixante " & ChiffreLettre(Dizaine - 61)
Case 70
T = "soixante-dix"
Case 71
T = "soixante et onze"
Case 72 To 79
T = "soixante " & ChiffreLettre(Dizaine - 61)
Case 80
T = "quatre vingts"
Case 81 To 89
T = "quatre vingt " & ChiffreLettre(Dizaine - 81)
Case 90 To 99
T = "quatre vingt " & ChiffreLettre(Dizaine - 81)
Case Else
T = "Erreur de conversion !"
End Select
If (Chaine & " " & T) = " " Then
lireCentaine = ""
Else
lireCentaine = LTrim(Chaine & " ") & T
End If


End Function
'-----------------
' Fonction Modulo
'-----------------
Function Modulo(ByVal Nombre As Double, ByVal Diviseur As Double) As Double
Modulo = Nombre - (Diviseur * Int(Nombre / Diviseur))
End Function
'-------------------
' Fonction Arrondir
'-------------------
Function Arrondir(ByVal ValeurArrondi As Double, ByVal NbreDeci As Integer) As Double
Arrondir = ValeurArrondi
Arrondir = Int(Arrondir * 10 ^ NbreDeci) / 10 ^ NbreDeci

End Function


'---------------------
' Fonction principale
'---------------------
Function ChiffreEnLettre(ByVal Total As Double) As String
Dim Milliards As Double
Dim Millions As Double
Dim Dinar As Double
Dim Cent As Double
Dim decimales As Double
Dim T0 As String
Dim T1 As String
Dim T2 As String
Dim T3 As String
Dim T4 As String
Dim Resultat As String
Dim T As String
Dim Devise1, Devise2, S1, S2 As String


'-------------------------------------------
' On décompose le nombre en tranche de cent
' Ainsi pour 2465,450 on a :
' Milliers=2
' Cent = 465
' decimales 450
'------------------------------------------
Milliards = Int(Modulo(Int(Total / 1000000), 1000))
Millions = Int(Modulo(Int(Total / 1000), 1000))
Dinar = Int(Modulo(Int(Total / 1), 1000))
'cent = Int(Modulo(Total, 1000))
decimales = Arrondir((Modulo(Total * 1000, 1000)), 0)

'Y-a-t'il un s ?
'---------------
S1 = ""
S2 = ""
'MsgBox (Milliers)
'MsgBox (cent)

'If Milliers <= 1 Then S1 = "" Else S1 = "s"
'If cent <= 1 Then
If Dinar < 1 Then
If Millions < 1 Then
S1 = ""
Else
S1 = "s"
End If
If Milliards < 1 Then
S1 = "s"
Else
S1 = "s"
End If
Else
S1 = "s"
End If
'Else
' S1 = "s"
'End If

If decimales <= 1 Then S2 = "" Else S2 = "s"
'If Total <= 1 Then S1 = "" Else S1 = "s"
'MsgBox (S1)
' Choix de la devise
'-------------------

Devise2 = " millime" & S1


'Total = InputBox("Entrer un nombre", "Conversion")
'MsgBox (Devise1)
'-------------------------------------------------------------------------
' La fonction lirecentaine permet de convertir chaque tranche en lettres
'-------------------------------------------------------------------------
T0 = lireCentaine(Milliards)
T1 = lireCentaine(Millions)
T2 = lireCentaine(Dinar)
'T3 = lireCentaine(Cent)
T4 = lireCentaine(decimales)

If (T0 = "" And T1 = "" And T2 = "" And T4 = "" And Right(T3, 10) = "cent ") Then
'If cent > 100 Then T3 = RTrim(T3) & "s"
End If
If T0 <> "" Then

Resultat = T0 & " milliard "
If T1 = "" And T2 = "" And T3 = "" And T4 = "" Then
Resultat = T1 & " milliard de"
End If
Else
Resultat = ""
End If
If T1 <> "" Then
If T1 = "" Then
T1 = ""
End If
Resultat = Resultat & T1 & " million "
Else
Resultat = Resultat & ""
End If

If T2 <> "" Then
If T2 = "" Then
T2 = ""
End If
Resultat = Resultat & T2 & " dinar "
Else
Resultat = Resultat & ""
End If

If T3 <> "" Then
Resultat = Resultat & T3 & Devise1
Else
If Resultat <> "" Then
Resultat = Resultat & Devise1
End If
End If
If T4 <> "" Then
If Resultat <> "" Then
Resultat = Resultat & T4 & Devise2
Else
Resultat = T4 & Devise2
End If
End If


'T = MsgBox(Resultat, vbOKOnly, "Résultat de la conversion")
ChiffreEnLettre = Resultat
End Function

Répondre à tacha84