Salut les mecs !

Juste pour partager  avec vous un code vbScript que je viens d'écrire dont le 
but est de prendre un nombre en chiffre, et le renvoyer en toutes lettres.

Un traitement pas si facile qu'il n'y parraît dans la langue de Molière.

Ce module est constitué de cinq fonctions que j'ai commenté de mon mieux.

Avant de vous le coller, je vous rappelle que le logiciel CodeArchiver vous 
permet de puiser et partager des bouts de codes source en ligne. Il est  
disponible à cette adresse:
http://www.visuweb.net/index.php?page=7

Voici le code

Début du code vbScript

' module vbScript de transformation de nombres en chiffres en nombres en toutes 
lettres
' par Yannick Daniel Youalé
' copiez le code de ce module dans un fichier à l'extension vbs
' et exécutez-le
' une boîte de dialogue vous demandera d'entrer le nombre à convertir,
' et le résultat vous sera affiché dans un dialogue MsgBox.

function ConvertUnit(sNumber)
'
dim tbl
on error resume next
tbl = array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", 
"neuf")
ConvertUnit = tbl(cInt(sNumber))
End function

Function ConvertTen(sNumber)
'
dim tbl
on error resume next
tbl = array("", "dix", "vingt", "trante", "quarante", "cinquante", "soixante", 
"soixante-dix", "quatre-vingt", "quatre-vingt-dix")
ConvertTen = tbl(cInt(sNumber))
End Function

function ConvertTenSpecial(sNumber)
' les nombres spéciaux de la langue française
' renvoi chaîne vide si aucune équivalance
dim s
dim i1
dim i2
s = ""
i1 = mid(sNumber, 1, 1)
i2 = mid(sNumber, 2, 1)
select case i1
case 1, 7, 9
if i2 = 1 then
if i1 <> 1 then  s = ConvertTen(i1 - 1)
s = s & " onze"
elseif i2 = 2 then
if i1 <> 1 then  s = ConvertTen(i1 - 1)
s = s & " douze"
elseif i2 = 3 then 
if i1 <> 1 then  s = ConvertTen(i1 - 1)
s = s & " treize"
elseif i2 = 4 then
if i1 <> 1 then  s = ConvertTen(i1 - 1)
s = s & " quatorze"
elseif i2 = 5 then
if i1 <> 1 then  s = ConvertTen(i1 - 1)
s = s & " quinze"
elseif i2 = 6 then
if i1 <> 1 then  s = ConvertTen(i1 - 1)
s = s & " seize"
end if
end select
' renvoi
ConvertTenSpecial = trim(s)
end function

function ConvertHundred(sNumber)
'
dim i
dim s
dim sHundred
dim sTen
dim sTenSpecial
dim sUnit
' ajout de 0 si nécessaire
i = 3 - len(sNumber)
if i > 0 then sNumber = string(i, "0") & sNumber
' centaine
sHundred = mid(sNumber, 1, 1)
' dixaine
sTen = mid(sNumber, 2, 1)
' unité
sUnit = mid(sNumber, 3, 1)
' centaine
if sHundred <> "0" then
s = ConvertUnit(sHundred) & " cent"
end if ' fin des centaines
' dixaine
' vérification si dixaine spéciale
sTenSpecial = ConvertTenSpecial(mid(sNumber, 2, 2))
if sTenSpecial <> "" then
s = s & " " & sTenSpecial
else
' si dixaine normale
if sTen <> "0" then
s = s & " " & ConvertTen(sTen)
end if ' fin des dixaines
' unité
if sTen <> "0" and sUnit = "1" then s = s & " et"
s = s & " " & ConvertUnit(sUnit) 
end if ' fin si dixaine spéciale ou pas
' renvoi
s = trim(s)
ConvertHundred =  s
end function

function ConvertNumber(sNumber)
dim i
dim s
dim s2
dim sHundred
' vérification si numérique
sNumber = trim(sNumber)
if IsNumeric(sNumber) = false then
ConvertNumber = ""
exit function
end if
' on complète avec des 0 
' jusqu'à  la longueur maximale
' qui est de 999 trillions.
' ce qui fait au maximum 15 caractères
i =15 - len(sNumber)
' exception
if i < 0 then
ConvertNumber = ""
exit function
end if
sNumber = string(i, "0") & sNumber
' parcours des cinq branches de trois caractères
' tout en complétant le texte résultat
s = ""
for i = 1 to 5
sHundred = mid(sNumber, (i * 3) - 2, 3)
s2 = ConvertHundred(sHundred)
' selon la branche
select case i
case 1 ' trillion
if s2 <> "" then
s = s & " " & s2 & " trillion"
' si pluriel
if s2 <> "un" then s = s & "s"
end if
case 2 ' milliard
if s2 <> "" then
s = s & " " & s2 & " milliard"
' si pluriel
if s2 <> "un" then s = s & "s"
end if
case 3 ' million
if s2 <> "" then
s = s & " " & s2 & " million"
' si pluriel
if s2 <> "un" then s = s & "s"
end if
case 4 ' millier
if s2 <> "" then
if s2 = "un" then
s = s & " mille"
else
s = s & " " & s2 & " mille"
end if
' si pluriel
if s2 <> "un" then s = s & "s"
end if
case 5 ' centaine
if s2 <> "" then
s = s & " " & s2
end if
end select
next ' branche de trois suivante
' renvoi
ConvertNumber = trim(s)
End function

function execute()
'
dim sNumber
sNumber = inputbox("Tapez le nombre à convertir en lettres")
MsgBox ConvertNumber(sNumber)
end function

' exécution
execute

Fin du code vbScript

Puisse cela être utile à quelqu'un !

Yannick Daniel Youalé
La programmation est une religion. Aimez-la, ou quittez-la.





Répondre à