Accueil > > > CONVERSION D'UN NOMBRE EN LETTRES
CONVERSION D'UN NOMBRE EN LETTRES
Information sur la source
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
Commentaires et avis
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
|
Derniers Blogs
[WP7] DYNAMICALLY CHANGE STARTUP PAGE[WP7] DYNAMICALLY CHANGE STARTUP PAGE par KooKiz
Let's say that you want to allow the user to customize the startup page of your application. You can easily change the startup page by editing the 'NavigationPage' attribute in the manifest file. But the manifest cannot be modified once the applicatio...
Cliquez pour lire la suite de l'article par KooKiz SESSION SILVERLIGHT 5 3D : SLIDES ET DEMOSSESSION SILVERLIGHT 5 3D : SLIDES ET DEMOS par Groc
Durant les techdays, j'ai eu le plaisir d'animer une session sur Silverlight 5 et la 3D avec Simon Ferquel. Comme promis, voici nos slides et mes démos (celles avec le viper BSG) ici et là. Pour mémoire, les démos utilisent toutes le viper BSG...
Cliquez pour lire la suite de l'article par Groc [TECHDAYS 2012] SESSION WEBMATRIX 2 : LE COUTEAU SUISSE GRATUIT POUR VOS DéVELOPPEMENTS WEB - SLIDES[TECHDAYS 2012] SESSION WEBMATRIX 2 : LE COUTEAU SUISSE GRATUIT POUR VOS DéVELOPPEMENTS WEB - SLIDES par gpommier
Suite à la session que j'ai présenté sur WebMatrix 2, vous pouvez trouver les slides ici, ainsi que les démos en packages nuget : démos1 et démos2 J'en profite pour remercier chaleureusement tous ceux qui sont venus très nombreux à cette sess...
Cliquez pour lire la suite de l'article par gpommier [SHAREPOINT] LES SESSIONS TECHDAYS 2012.[SHAREPOINT] LES SESSIONS TECHDAYS 2012. par Patrick Guimonet
Voici donc pour ceux qui n'ont pas pu venir, ou ceux qui n'ont pas pu toutes les suivre la liste des sessions SharePoint aux TechDays 2012, que je mettrais à jour dès que les liens des vidéo seront disponibles. Ou ici : http...
Cliquez pour lire la suite de l'article par Patrick Guimonet TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3 par ROMELARD Fabrice
Speaker: Bernard Ourghanlian Cette session est comme chaque jour transmise en live par BrainSonic, et j'ai donc suivi cette troisième pleinière par ce moyen sur mon iPad . Elle est dédiée comme chaque année à la mise en perspective de l'é...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Forum
LISTER KEYS.KEYLISTER KEYS.KEY par Onin42
Cliquez pour lire la suite par Onin42
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
|