Visual Basic, VB6, VB.NET, VB 2005, VB CodeS-SourceS

CodeS-SourceS est hébergé par Frontier.fr

Ce site au démarrage

begin process at 2012 02 13 08:34:21

Accueil Codes Tutoriels Forum Livres Emploi Services Connexion

Trouver un code source :

dans

[ Dernières recherches ]

Accueil >

CONVERSION D'UN NOMBRE EN LETTRES

Information sur la source

Note :

8,00 / 10

Catégorie :Modules Classé sous :conversion, nombre, lettre Niveau :Initié Date de création :19/03/2001 Date de mise à jour :13/02/2004 19:06:04 Vu :22 123

Auteur : gipp

Ecrire un message privé

Site perso

Commentaire sur cette source (7)

Ajouter un commentaire et/ou une note

Description

La fonction NversL convertit une valeur numérique donnée dans le 1er argument en valeurs en toutes lettres.

Dans les arguments 2 et 3, il faudra donner les unités de mesure de la valeur (voir exemples).

Cette fonction pourra être utilisée dans Word, Excel, Access, Visual Basic et bien d'autres logiciels.

La page de mon site Web présentant cette fonction est : http://www.chez.com/gipp/developpements/nversl/

Source

Public Function NversL(NversL_n As Double, NversL_entier As String, NversL_réél As String)
'*** Auteur : Gilles PFOTZER (GIPP)
'*** http://www.chez.com/gipp/
Dim NversL_n1 As Double
Dim NversL_n2 As Single
Dim NversL_t As String
Dim NversL_x As String
NversL_n1 = NversL_n
NversL_t = ""
'Erreur
If NversL_n1 > 999999999.99 Then
NversL = "Erreur !"
Exit Function
End If
'Million
NversL_n2 = Int(NversL_n1 / 1000000)
NversL_x = NversL_cent(NversL_n2, False)
NversL_n1 = NversL_n1 - NversL_n2 * 1000000
If Trim(NversL_x) <> "zéro" Then
NversL_t = NversL_t & NversL_x & " million"
If Trim(NversL_x) <> "un" Then NversL_t = NversL_t & "s"
'Pour avoir 'un million [de] francs'
If Int(NversL_n1) = 0 Then NversL_t = NversL_t & " de"
End If
'Millier
NversL_n2 = Int(NversL_n1 / 1000)
NversL_x = NversL_cent(NversL_n2, True)
NversL_n1 = NversL_n1 - NversL_n2 * 1000
If Trim(NversL_x) <> "zéro" Then
If Trim(NversL_x) <> "un" Then
NversL_t = NversL_t & NversL_x & " mille"
Else
NversL_t = NversL_t & " mille"
End If
End If
'Unité
NversL_n2 = Int(NversL_n1)
NversL_x = NversL_cent(NversL_n2, False)
NversL_n1 = NversL_n1 - NversL_n2
If Trim(NversL_x) <> "zéro" Then NversL_t = NversL_t & NversL_x
'zéro
If Len(NversL_t) = 0 Then NversL_t = "zéro"
'Franc(s)
If NversL_entier <> "" Then NversL_t = NversL_t & " " & NversL_entier
If Int(NversL_n) > 1 And Trim(NversL_entier) <> "" Then NversL_t = NversL_t & "s"
'Dixième
NversL_n2 = CInt(NversL_n1 * 100)
NversL_x = NversL_cent(NversL_n2, False)
NversL_n1 = NversL_n1 - NversL_n2
If Trim(NversL_x) <> "zéro" Then
NversL_t = NversL_t & " et" & NversL_x & IIf(NversL_réél <> "", " " & NversL_réél, "")
If NversL_n2 > 1 And Trim(NversL_réél) <> "" Then NversL_t = NversL_t & "s"
End If
NversL_t = Trim(NversL_t)
NversL = UCase(Left(NversL_t, 1)) & Right(NversL_t, Len(NversL_t) - 1)
End Function
Private Function NversL_cent(n_cent As Single, mille_cent As Boolean)
'mille_cent : 'oui' si sa correspond à un millier
Dim n1_cent As Single
Dim n2_cent As Single
Dim t_cent As String
Dim x_cent As String
n1_cent = n_cent
t_cent = ""
'Centaine
n2_cent = Int(n1_cent / 100)
x_cent = NversL_chiffre(n2_cent)
n1_cent = n1_cent - n2_cent * 100
If Trim(x_cent) <> "zéro" Then
If Trim(x_cent) <> "un" Then t_cent = t_cent & " " & x_cent
t_cent = t_cent & " cent"
If Trim(x_cent) <> "un" Then
'Pas de 's' s'il y a un nombre derrière la centaine
If n1_cent = 0 Then
'Pas de 's' s'il y a le mot 'mille' derrière la centaine
If Not mille_cent Then t_cent = t_cent & "s"
End If
End If
End If
'Dizaine
n2_cent = n1_cent
Select Case n2_cent
Case 0 To 9
x_cent = NversL_chiffre(n2_cent)
Case 10
x_cent = "dix"
Case 11
x_cent = "onze"
Case 12
x_cent = "douze"
Case 13
x_cent = "treize"
Case 14
x_cent = "quatorze"
Case 15
x_cent = "quinze"
Case 16
x_cent = "seize"
Case 17
x_cent = "dix-sept"
Case 18
x_cent = "dix-huit"
Case 19
x_cent = "dix-neuf"
Case 20
x_cent = "vingt"
Case 21
x_cent = "vingt et un"
Case 22 To 29
x_cent = "vingt-" & NversL_chiffre(n2_cent - Int(n2_cent / 10) * 10)
Case 30
x_cent = "trente"
Case 31
x_cent = "trente et un"
Case 32 To 39
x_cent = "trente-" & NversL_chiffre(n2_cent - Int(n2_cent / 10) * 10)
Case 40
x_cent = "quarante"
Case 41
x_cent = "quarante et un"
Case 42 To 49
x_cent = "quarante-" & NversL_chiffre(n2_cent - Int(n2_cent / 10) * 10)
Case 50
x_cent = "cinquante"
Case 51
x_cent = "cinquante et un"
Case 52 To 59
x_cent = "cinquante-" & NversL_chiffre(n2_cent - Int(n2_cent / 10) * 10)
Case 60
x_cent = "soixante"
Case 61
x_cent = "soixante et un"
Case 62 To 69
x_cent = "soixante-" & NversL_chiffre(n2_cent - Int(n2_cent / 10) * 10)
Case 70
x_cent = "soixante-dix"
Case 71
x_cent = "soixante et onze"
Case 72 To 79
x_cent = "soixante-" & Trim(NversL_cent(n2_cent - 60, False))
Case 80
x_cent = "quatre-vingts"
Case 81 To 99
x_cent = "quatre-vingt-" & Trim(NversL_cent(n2_cent - 80, False))
End Select
n1_cent = n1_cent - n2_cent
'Pour éviter 'cent zéro'
If Len(t_cent) = 0 Or Trim(x_cent) <> "zéro" Then t_cent = t_cent & " " & x_cent
NversL_cent = t_cent
End Function
Private Function NversL_chiffre(n_chiffre As Single)
Dim n1_chiffre As Single
Dim t_chiffre As String
n1_chiffre = n_chiffre
Select Case n1_chiffre
Case 0
t_chiffre = "zéro"
Case 1
t_chiffre = "un"
Case 2
t_chiffre = "deux"
Case 3
t_chiffre = "trois"
Case 4
t_chiffre = "quatre"
Case 5
t_chiffre = "cinq"
Case 6
t_chiffre = "six"
Case 7
t_chiffre = "sept"
Case 8
t_chiffre = "huit"
Case 9
t_chiffre = "neuf"
End Select
NversL_chiffre = t_chiffre
End Function

Public Function NversL(NversL_n As Double, NversL_entier As String, NversL_réél As String)

   '*** Auteur : Gilles PFOTZER (GIPP)
   '*** http://www.chez.com/gipp/

   Dim NversL_n1 As Double
   Dim NversL_n2 As Single
   Dim NversL_t As String
   Dim NversL_x As String

   NversL_n1 = NversL_n
   NversL_t = ""

   'Erreur
   If NversL_n1 > 999999999.99 Then
      NversL = "Erreur !"
      Exit Function
   End If

   'Million
   NversL_n2 = Int(NversL_n1 / 1000000)
   NversL_x = NversL_cent(NversL_n2, False)
   NversL_n1 = NversL_n1 - NversL_n2 * 1000000
   If Trim(NversL_x) <> "zéro" Then
      NversL_t = NversL_t & NversL_x & " million"
      If Trim(NversL_x) <> "un" Then NversL_t = NversL_t & "s"

      'Pour avoir 'un million [de] francs'
      If Int(NversL_n1) = 0 Then NversL_t = NversL_t & " de"
   End If 

   'Millier
   NversL_n2 = Int(NversL_n1 / 1000)
   NversL_x = NversL_cent(NversL_n2, True)
   NversL_n1 = NversL_n1 - NversL_n2 * 1000
   If Trim(NversL_x) <> "zéro" Then
      If Trim(NversL_x) <> "un" Then
         NversL_t = NversL_t & NversL_x & " mille"
      Else
         NversL_t = NversL_t & " mille"
      End If
   End If

   'Unité
   NversL_n2 = Int(NversL_n1)
   NversL_x = NversL_cent(NversL_n2, False)
   NversL_n1 = NversL_n1 - NversL_n2
   If Trim(NversL_x) <> "zéro" Then NversL_t = NversL_t & NversL_x

   'zéro
   If Len(NversL_t) = 0 Then NversL_t = "zéro"

   'Franc(s)
   If NversL_entier <> "" Then NversL_t = NversL_t & " " & NversL_entier
   If Int(NversL_n) > 1 And Trim(NversL_entier) <> "" Then NversL_t = NversL_t & "s"

   'Dixième
   NversL_n2 = CInt(NversL_n1 * 100)
   NversL_x = NversL_cent(NversL_n2, False)
   NversL_n1 = NversL_n1 - NversL_n2
   If Trim(NversL_x) <> "zéro" Then
      NversL_t = NversL_t & " et" & NversL_x & IIf(NversL_réél <> "", " " & NversL_réél, "")
      If NversL_n2 > 1 And Trim(NversL_réél) <> "" Then NversL_t = NversL_t & "s"
   End If
   NversL_t = Trim(NversL_t)
   NversL = UCase(Left(NversL_t, 1)) & Right(NversL_t, Len(NversL_t) - 1)

End Function

Private Function NversL_cent(n_cent As Single, mille_cent As Boolean)
'mille_cent : 'oui' si sa correspond à un millier

   Dim n1_cent As Single
   Dim n2_cent As Single
   Dim t_cent As String
   Dim x_cent As String

   n1_cent = n_cent
   t_cent = ""

   'Centaine
   n2_cent = Int(n1_cent / 100)
   x_cent = NversL_chiffre(n2_cent)
   n1_cent = n1_cent - n2_cent * 100
   If Trim(x_cent) <> "zéro" Then
      If Trim(x_cent) <> "un" Then t_cent = t_cent & " " & x_cent
      t_cent = t_cent & " cent"
      If Trim(x_cent) <> "un" Then

         'Pas de 's' s'il y a un nombre derrière la centaine
         If n1_cent = 0 Then

            'Pas de 's' s'il y a le mot 'mille' derrière la centaine
            If Not mille_cent Then t_cent = t_cent & "s"
         End If
      End If
   End If

   'Dizaine
   n2_cent = n1_cent
   Select Case n2_cent
      Case 0 To 9
         x_cent = NversL_chiffre(n2_cent)
      Case 10
         x_cent = "dix"
      Case 11
         x_cent = "onze"
      Case 12
         x_cent = "douze"
      Case 13
         x_cent = "treize"
      Case 14
         x_cent = "quatorze"
      Case 15
         x_cent = "quinze"
      Case 16
         x_cent = "seize"
      Case 17
         x_cent = "dix-sept"
      Case 18
         x_cent = "dix-huit"
      Case 19
         x_cent = "dix-neuf"
      Case 20
         x_cent = "vingt"
      Case 21
         x_cent = "vingt et un"
      Case 22 To 29
         x_cent = "vingt-" & NversL_chiffre(n2_cent - Int(n2_cent / 10) * 10)
      Case 30
         x_cent = "trente"
      Case 31
         x_cent = "trente et un"
      Case 32 To 39
         x_cent = "trente-" & NversL_chiffre(n2_cent - Int(n2_cent / 10) * 10)
      Case 40
         x_cent = "quarante"
      Case 41
         x_cent = "quarante et un"
      Case 42 To 49
         x_cent = "quarante-" & NversL_chiffre(n2_cent - Int(n2_cent / 10) * 10)
      Case 50
         x_cent = "cinquante"
      Case 51
         x_cent = "cinquante et un"
      Case 52 To 59
         x_cent = "cinquante-" & NversL_chiffre(n2_cent - Int(n2_cent / 10) * 10)
      Case 60
         x_cent = "soixante"
      Case 61
         x_cent = "soixante et un"
      Case 62 To 69
         x_cent = "soixante-" & NversL_chiffre(n2_cent - Int(n2_cent / 10) * 10)
      Case 70
         x_cent = "soixante-dix"
      Case 71
         x_cent = "soixante et onze"
      Case 72 To 79
         x_cent = "soixante-" & Trim(NversL_cent(n2_cent - 60, False))
      Case 80
         x_cent = "quatre-vingts"
      Case 81 To 99
         x_cent = "quatre-vingt-" & Trim(NversL_cent(n2_cent - 80, False))
   End Select

   n1_cent = n1_cent - n2_cent

   'Pour éviter 'cent zéro'
   If Len(t_cent) = 0 Or Trim(x_cent) <> "zéro" Then t_cent = t_cent & " " & x_cent
   NversL_cent = t_cent

End Function


Private Function NversL_chiffre(n_chiffre As Single)

   Dim n1_chiffre As Single
   Dim t_chiffre As String

   n1_chiffre = n_chiffre

   Select Case n1_chiffre
      Case 0
         t_chiffre = "zéro"
      Case 1
         t_chiffre = "un"
      Case 2
         t_chiffre = "deux"
      Case 3
         t_chiffre = "trois"
      Case 4
         t_chiffre = "quatre"
      Case 5
         t_chiffre = "cinq"
      Case 6
         t_chiffre = "six"
      Case 7
         t_chiffre = "sept"
      Case 8
         t_chiffre = "huit"
      Case 9
         t_chiffre = "neuf"
   End Select

   NversL_chiffre = t_chiffre

End Function

Conclusion

Exemples :
NversL (12.10, "franc", "centime")
   résultat : "Douze francs et dix centimes"
NversL (19, "", "")
   résultat : "Dix-neuf"
NversL (12, "kilo", "")
   résultat : "Douze kilos"
NversL(190285857.2654,"franc","centime")
   résultat : "Cent quatre-vingt-dix millions deux cent quatre-vingt-cinq mille huit cent cinquante-sept francs et vingt-sept centimes"

Sources de la même categorie

CRYPTAGE ET DECRYPTAGE par jerichez

EXEMPLE MODBUS POUR MODULES ADAM, BECKHOFF, WAGO par mnmsjaune

CRÉER SON PROPRE DESIGNER COMME CELUI DE VISUAL STUDIO par ShareVB

CONVERSION UTM VERS LAT/LONG par BarresLTD

CPROPGROUP : COLLECTION FAITE MAISON par Flocreate

Toutes les sources de la catégorie Modules

Sources en rapport avec celle ci

CONVERSION D'UN CHIFFRE EN LETTRE par Berurier

CONVERTIR DES CHIFFRES EN LETTRES AVEC OU SANS DÉCIMALE ET/O... par gandalf27

TRANSFORMER UN NOMBRES EN LETTRES (TRÈS OPTIMISER) par ouiss

ECRIRE DES NOMBRES EN TOUTES LETTRES (MULTI-LANGUAGE) par santiago69

CHIFFRE EN LETTRE FONCTION par ElDoktor

Commentaires et avis

Commentaire de skaferadics le 02/04/2002 22:35:41

ohé pas mal ton code
mais a la place de select case tu aurai pu utiliser un tableau
ca aurai racourci le code!

Commentaire de magour le 30/07/2003 19:37:06

tres bon code
ça ma ete tres utile

Commentaire de wajdi le 09/07/2004 18:19:38

bravo mais tu peut l'améliorer en ajoutant une variable qui prend en charge les aprés vérgule, CAD une variable qui divise les aprés virgule soit par dix, utile pour cetaines applications, soit par cent, utile pour le dollar et l'euro par exemple ou alors par 1000 car cetraines devises comme le dinar, le yen sont divisible par 1000.
encore bravo pour ton code.

Commentaire de tempusus le 27/07/2004 13:20:22 administrateur CS

Je suis tombé sur cette source par hazard et la trouve vraiment bien faite. Elle est facile à faire passer en euros et fonctionne avec tout :)

Et en plus elle est commentée :p

8/10

Cordialement

Tempusus - Admin CS - MVP Windows

Commentaire de CanisLupus le 28/07/2004 23:35:33 administrateur CS

snif, g mis un truc du même genre mais g pas de note :
http://www.vbfrance.com/code.aspx?ID=20777
mais bah, c vrai que le mien ne traite que des euros.

Allez, un 10.

Commentaire de aladdin_wydadi le 07/06/2005 00:57:43

svp les amis essaie de traduiser le code source de conversion en langage c j'ai trés besoin de ca urgent et merci .

Commentaire de achassa le 28/01/2006 03:08:50

C'est une FONCTION très utile (remplir son chéquier sans fautes, l'intégrer ds des applications...) et son algorithme n'est pas facile à réaliser (d'abord faire des recherches sur les adjectifs numéraux pour savoir tous les cas puis les gérer intelligemment... ), alors je te dis BRAVO et je donne 09/10. Je crois que j'ai fait qlq chose de pareil sur mon site perso(http://perso.menara.ma/~achhass/LectNbre/LectNbre.htm) avec du javaScript pour des entiers positifs<=999999999999.

Une petite remarque concernant les arrondis: un contre exemple:
10.245 m'a donné en lettres 10.24 alors que
10.345 m'a donné en lettres 10.35
En d'autres termes,
NversL(10.245,"franc","centime")
résultat :"Dix francs et vingt-quatre centimes"
NversL(10.345,"franc","centime")
résultat :"Dix francs et vingt-cinq centimes"

Je suis sûr que tu vas résoudre ce ptit problème sans problème si ce n'est pas déjà fais!
%%%%%Bonne continuiation%%%%%

Ajouter un commentaire

Discussions en rapport avec ce code source dans le forum

Conversion chaine de caracteres en un nombre entier [ par tntdavid ] Je voudrais connaitre le code VB d'une fonction qui me permettrait de convertir une chaine de 6 caractères en un nombre entier.Merci d'avance de l'att Conversion d'un nombre entier en une chaine de caractère [ par Janot ] Ben, je n'arrive pas à trouver la fonction qui convertit un nombre entier en une chaine de caractères (je connaîs seulement Val qui fait l'inverse).Me conversion qbasic en VB6 [ par Jeanlouis ] Bonjour,J'aimerai savoir comment convertir ce programme qbasic en vb6?ClsPrint " choisir le programme de conversion qui vous convient"Print " ----- Ecrire un nombre en toute lettre [ par jayrock ] BonjourJ'aimerais savoir si quelqu'un a déjà fait un programme qui permet à partir d'une chaine de caractères "495" de traduire ça part "quatre cent q conversion de nombre en notation scientifique [ par zhebulonn ] Je voudrais pouvoir recuperer un nombre a virgule (i.e 0.0011) et non pas le nombre en notation scientifique (i.e 1.1e-3). Comment faire ?? Ascii conversion chiffre <=> lettre [ par deetsrider ] Je voudrais rajouter +1 au code ascii de chaque lettre tapée dans un textbox puis le reinscrire dans l autre textbox avec son nouveau code ..."a" devi récupération d'une variable ! [ par cyberlulu ] Salut tout le mondedans le programme que je suis en train de faire, j'enregistre le nombre 0 dans la variable a, le nombre 1 dans la variable b, le 2 Transformer un nombre en chiffre [ par blacksanga ] Salut Je travail dans word pour un envoie de lettre en publipostage,dans cette lettre j'ai un champs contenant un nombre (par exemple: 548000) j'aimer CONVERSION EN NOMBRE D'ANNEES [ par clara2ci ] Bonjour,Je souhaite obtenir l'age d'une personnes :j'ai un champ date du jour et un champ date de naissance.Sur accès j'ai mis dans le source controle comptage d'une lettre précise dans textbox [ par c@simir ] Bonjour !!Je souhaiterais compter le nombre de fois où un charactére apparait :par exemple j'ai une chaine :sdssdsdsdddsdsdsdsddsdsdsdsddje voudrais c

Nos sponsors

Derniers Blogs

[WP7] DYNAMICALLY CHANGE STARTUP PAGE par KooKiz

SESSION SILVERLIGHT 5 3D : SLIDES ET DEMOS par Groc

[TECHDAYS 2012] SESSION WEBMATRIX 2 : LE COUTEAU SUISSE GRATUIT POUR VOS DéVELOPPEMENTS WEB - SLIDES par gpommier

[SHAREPOINT] LES SESSIONS TECHDAYS 2012. par Patrick Guimonet

TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3 par ROMELARD Fabrice

Forum

RE : LISTER KEYS.KEY par ucfoutu

RE : LISTER KEYS.KEY par Renfield

RE : RECORDSET DE VB6 à VB2010...GRRRRRRRR par Renfield

LISTER KEYS.KEY par Onin42

Côté IT

Offres d'emploi

Formations Video

Appels d'offres

Passerelle Pericles sur site Joomla 17
Budget : 499€
Infogerance Serveur Debian Linux
Budget : 2 400€
Developpeur applications iphone - ipad - android
Budget : 800€

Logiciels

Tribler (2012)
TRIBLER (2012)

Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des...

Cliquez pour télécharger Tribler
OneSwarm (2012)
ONESWARM (2012)

Le peer-to-peer qui protège votre vie privée, c'est OneSwarm. Ce logiciel de peer-to-peer crypté...

Cliquez pour télécharger OneSwarm
PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)
PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)

PONAMEDIA TV DEVIENS HELLLOOO FLASH LA TV SUR VOTRE ORDINATEUR. Toute une plateforme Multi...

Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO
Academy System (17.2.1.0)
ACADEMY SYSTEM (17.2.1.0)

Logiciel de gestion des établissements. - élèves/étudiants (inscription, dossier, absence...) -...

Cliquez pour télécharger Academy System
Easy-Planning (1.0.0.1)
EASY-PLANNING (1.0.0.1)

Basé sur les mêmes principes que MyPlanning, Easy-Planning permet de créer des plannings sous la ...

Cliquez pour télécharger Easy-Planning