Programme NversL

NVERSL

Fonction réalisée en Visual Basic en Septembre 1997.

La fonction NversL convertit une valeur numérique donnée dans le 1^er 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.

String NversL (Double, String, String)

Exemples :

NversL (12.10, "euro", "cent")

"Douze euros et dix cents"

NversL (19, "", "")

"Dix-neuf"

NversL (12, "kilo", "")

"Douze kilos"

NversL(190285857.2654,"euro","cent")

"Cent quatre-vingt-dix millions deux cent quatre-vingt-cinq mille huit cent cinquante-sept euros et vingt-sept cents"

Vous avez ici la source en Visual Basic à recopier dans un langage comprenant le Visual Basic :

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

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"

End If

'Pour avoir 'un million [de] francs'

If Int(NversL_n1) = 0 Then

NversL_t = NversL_t & " de"

End If

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

End If

'zéro

If Len(NversL_t) = 0 Then

NversL_t = "zéro"

End If

'Franc(s)

If NversL_entier <> "" Then

NversL_t = NversL_t & " " & NversL_entier

End If

If Int(NversL_n) > 1 And Trim(NversL_entier) <> "" Then

NversL_t = NversL_t & "s"

End If

'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

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

End If

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

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

End If

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