Ce code permet de convertir des nombre en toute lettres ( version pour les nombre Arabe = convertion en Text Arabe ).
Ce code existe en Français je viens le localizé pour unre version Arabisé.
le code en français est sur le site.
( noublier pas il faut un system qui suporte la langue Arabe pour faire marcher ce code )
Source / Exemple :
'
' ---------------------------------------------
' FONCTION DE TRADUCTION D'UNE SOMME EN LETTRES
' ---------------------------------------------
'
Option Explicit
Option Base 1
Public Unité As Variant
Public dizaine As Variant
Public Décimales As Currency
Public CasPart As Variant
Public Lettres As String
Public Numlettre As String
Public Cent_Pluriel As Boolean
Public Vingt_Pluriel As Boolean
'
' -------------------
' FONCTION PRINCIPALE ARABIC version
' -------------------
'
Function NombresEnLettresAR(Nombre As Currency) As String
' Limitation à 999 999 999 999 . 99
If Nombre >= 1000000000000# Then
MsgBox "Ce nombre est trop grand !", 0, "Message"
Exit Function
End If
' Initialisation des tableaux
Unité = Array("æÇÍÏ", "ÇËäíä", "ËáÇËÉ", "ÇÑÈÚÉ", "ÎãÓÉ", "ÓÊÉ", "ÓÈÚÉ", "ËãÇäíÉ", "ÊÓÚÉ")
dizaine = Array("ÚÔÑÉ", "ÚÔÑæä", "ËáÇËæä", "ÇÑÈÚæä", "ÎãÓæä", "ÓÊæä", "ÓÈÚæä", "ËãÇäæä", "ÊÓÚæä")
CasPart = Array("ÚÔÑÉ", "ÇÍÏ ÚÔÑÉ", "ÇËä ÚÔÑÉ", "ËáÇËÉ ÚÔÑÉ", "ÇÑÈÚÉ ÚÔÑÉ", "ÎãÓÉÚÔÑÉ", "ÓÊÉÚÔÑÉ", "ÓÈÚÉÚÔÑÉ", "ËãÇäíÉ ÚÔÑÉ", "ÊÓÚÉ ÚÔÑÉ")
' Mise à vide de la chaîne de réception de la traduction du nombre
Lettres = ""
' Initialisation des indicateurs de pluriel des nombres cent et vingt
Cent_Pluriel = True
Vingt_Pluriel = True
' Conversion de la partie décimale en un nombre de 0 à 99
' arrondi à l'unité la plus proche
Décimales = CInt((Nombre - Fix(Nombre)) * 100)
' Conservation de la partie entière du nombre
Nombre = Fix(Nombre)
' Orientation du traitement suivant valeur de la partie entière
Select Case Nombre
Case 0
Lettres = "ÕÝÑ"
Case 1 To 9
Lettres = Unité(CInt(Nombre))
Case 10 To 99
Trt_Dizaines Nombre
Case 100 To 999
Trt_Centaines Nombre
Case 1000 To 999999999999#
Trt_Multiples_de_Mille Nombre
End Select
' Indication de la monnaie
If Nombre > 1 Then
' if then
Lettres = Lettres & " ãáíã"
'Else
'End If
Else
Lettres = Lettres & " ãáíã"
End If
' Orientation du traitement suivant valeur de la partie décimale
Select Case Décimales
Case 1 To 9
Lettres = Lettres & Unité(CInt(Décimales))
Case 10 To 99
Trt_Dizaines Décimales
End Select
' Indication des centimes
Select Case Décimales
Case 1
Lettres = Lettres & " ãÇÆÉ"
Case Is > 1
Lettres = Lettres & " ãÇÆÉ"
End Select
' Renvoi du nombre traduit en lettres
NombresEnLettresAR = Lettres
End Function
'
' --------------------------------
' TRAITEMENT DES MULTIPLES DE 1000
' --------------------------------
'
Sub Trt_Multiples_de_Mille(Nombre As Currency)
Dim Rank As Currency
Dim Nom_Rang As String
Dim Reste As Currency
Cent_Pluriel = False
Vingt_Pluriel = False
' Initialisation suivant taille du nombre : milliers, millions ou milliards
Select Case Nombre
Case 1000 To 999999
Rank = Fix(Nombre / 1000)
Reste = Nombre Mod 1000
Nom_Rang = "ÂáÇÝ"
Case 1000000 To 999999999
Rank = Fix(Nombre / 1000000)
Reste = Nombre Mod 1000000
If Rank > 1 Then
Nom_Rang = "ãáÇííä"
Else
Nom_Rang = "ãáíæä"
End If
Case Is > 999999999
Rank = Fix(Nombre / 1000000000)
Reste = Nombre - Rank * 1000000000
If Rank > 1 Then
Nom_Rang = "ÇáÝ ãáíæä"
Else
Nom_Rang = "ÂáÇÝ Çáãáíæä"
End If
End Select
' Traitement du rang des milliers, millions ou milliards
Select Case Rank
Case 1
If Nom_Rang = "ÇáÝ" Then
Lettres = Lettres & "ÂáÇÝ"
Else
Lettres = Lettres & Unité(CInt(Rank)) & " " & Nom_Rang '& " æ"
End If
Case 2 To 9
'MsgBox ("Lettres = " & Lettres)
'MsgBox ("Unité(CInt(Rank)) = " & Unité(CInt(Rank)))
'MsgBox ("Nom_Rang = " & Nom_Rang)
Lettres = Lettres & Unité(CInt(Rank)) & " " & Nom_Rang '& " æ"
Case 10 To 99
Trt_Dizaines (Rank)
Lettres = Lettres & " " & Nom_Rang '& " æ"
Case 100 To 999
Trt_Centaines Rank
Lettres = Lettres & " " & Nom_Rang '& " æ"
End Select
Cent_Pluriel = True
Vingt_Pluriel = True
' Orientation du traitement du reste si > 0
Select Case Reste
Case 1 To 9
Lettres = Lettres & " æ" & " " & Unité(CInt(Reste))
Case 10 To 99
Lettres = Lettres & " æ" & " "
Trt_Dizaines Reste
Case 100 To 999
Lettres = Lettres & " æ" & " "
Trt_Centaines Reste
Case Is > 999
Lettres = Lettres & " æ" & " "
Trt_Multiples_de_Mille Reste
Case Else
Lettres = Lettres & " "
End Select
Lettres = Lettres
End Sub
'
' -----------------------------------
' TRAITEMENT DES NOMBRES DE 100 0 999
' -----------------------------------
'
Sub Trt_Centaines(Nombre As Currency)
Dim Rank As Currency
Dim Reste As Currency
Rank = Fix(Nombre / 100)
Reste = Nombre Mod 100
' Traitement du rang des centaines
If Rank = 1 Then
If Reste = 0 Then
Lettres = Lettres & "ãÇÆÉ"
Else
Lettres = Lettres & "ãÇÆÉ" & " æ"
End If
Else
If Reste = 0 And Cent_Pluriel Then
Lettres = Lettres & Unité(CInt(Rank)) & " " & "ãÇÆÉ"
Else
Lettres = Lettres & Unité(CInt(Rank)) & " " & "ãÇÆÉ" & " æ"
End If
End If
' Traitement du reste < 100
Select Case Reste
Case 1 To 9
Lettres = Lettres & " " & Unité(CInt(Reste))
Case Is > 9
Lettres = Lettres & " "
Vingt_Pluriel = True
Trt_Dizaines (Reste)
End Select
End Sub
'
' ---------------------------------
' TRAITEMENT DES NOMBRES DE 10 0 99
' ---------------------------------
'
Sub Trt_Dizaines(Nombre As Currency)
Dim Reste As Integer
Dim Rank As Integer
Rank = Fix(Nombre / 10)
Reste = Nombre Mod 10
Select Case Rank
Case 1
Lettres = Lettres & CasPart(Reste + 1)
Case 7
Select Case Reste
Case 0
' Nombre 70
Lettres = Lettres & dizaine(Rank)
Case Else
' Nombre 71 à 76
Lettres = Lettres & Unité(CInt(Reste)) & " æ " & dizaine(Rank)
End Select
Case 8
If Reste = 0 Then
' Nombre 80
Lettres = Lettres & dizaine(Rank)
Else
' Nombres 81 à 89
Lettres = Lettres & Unité(CInt(Reste)) & " æ " & dizaine(Rank)
End If
Case 9
If Reste = 0 Then
' Nombres 90
Lettres = Lettres & dizaine(Rank)
Else
' Nombres 91 à 99
Lettres = Lettres & Unité(CInt(Reste)) & " æ " & dizaine(Rank)
End If
Case Else
' Nombres 20 à 69
Select Case Reste
Case 0
' Nombres 20, 30, 40, 50, 60
Lettres = Lettres & dizaine(Rank)
Case Else
' Autres nombres
Lettres = Lettres & Unité(CInt(Reste)) & " æ " & dizaine(Rank)
End Select
End Select
End Sub
'
' -------------------
' FONCTION PRINCIPALE FRENCH version
' -------------------
'
Function NombresEnLettresFR(nb As Currency)
On Error GoTo erreur_montant
Dim varnum, varnumD, varnumU, varlet, résultat
'varnum : pour stocker les parties du nombre que l'on va découper
'varlet : pour stocker la conversion en lettres d'une partie du nombre
'varnumD : pour stocker la partie dizaine d'un nombre à 2 chiffres
'varnumU : pour stocker la partie unité d'un nombre à 2 chiffres
'résultat : pour stocker les résultats intermédiaires des différentes étapes
Static chiffre(1 To 19) '*** tableau contenant le nom des 16 premiers nombres en lettres
chiffre(1) = "un"
chiffre(2) = "deux"
chiffre(3) = "trois"
chiffre(4) = "quatre"
chiffre(5) = "cinq"
chiffre(6) = "six"
chiffre(7) = "sept"
chiffre(8) = "huit"
chiffre(9) = "neuf"
chiffre(10) = "dix"
chiffre(11) = "onze"
chiffre(12) = "douze"
chiffre(13) = "treize"
chiffre(14) = "quatorze"
chiffre(15) = "quinze"
chiffre(16) = "seize"
chiffre(17) = "dix sept"
chiffre(18) = "dix huit"
chiffre(19) = "dix neuf"
Static dizaine(1 To 8) '*** tableau contenant les noms des dizaines
dizaine(1) = "dix"
dizaine(2) = "vingt"
dizaine(3) = "trente"
dizaine(4) = "quarante"
dizaine(5) = "cinquante"
dizaine(6) = "soixante"
dizaine(8) = "quatre vingt"
'*** Traitement du cas zéro franc
If nb >= 1 Then
résultat = ""
Else
résultat = "zéro"
GoTo fintraitementfrancs
End If
'*** Traitement des millions
varnum = Int(nb / 1000000)
If varnum > 0 Then
GoSub centaine_dizaine
résultat = varlet + " million"
If varlet <> "un" Then résultat = résultat + "s"
End If
'
'*** Traitement des milliers
varnum = Int(nb) Mod 1000000
varnum = Int(varnum / 1000)
If varnum > 0 Then
GoSub centaine_dizaine
If varlet <> "un" Then résultat = résultat + " " + varlet
résultat = résultat + " mille"
End If
'
'*** Traitement des centaines et dizaines
varnum = Int(nb) Mod 1000
If varnum > 0 Then
GoSub centaine_dizaine
résultat = résultat + " " + varlet
End If
résultat = LTrim(résultat)
varlet = Right$(résultat, 4)
'
'*** Traitement du "s" final pour vingt et cent et du "de" pour million
Select Case varlet
Case "cent", "ingt"
résultat = résultat + "s"
Case "lion", "ions"
résultat = résultat + " de"
End Select
fintraitementfrancs: '*** Etiquette de branchement pour le cas "zéro franc"
'
'*** Indication du terme franc
résultat = résultat + " euro"
If nb >= 2 Then résultat = résultat + "s "
'
'*** Traitement des centimes
varnum = Int((nb - Int(nb)) * 1000 + 0.5) '*** On additionne 0,5
'*** afin de compenser
'*** les erreurs de calcul
'*** dues aux arrondis
If varnum > 0 Then
GoSub centaine_dizaine
résultat = résultat + " et " + varlet + " Centimes"
'If varnum > 1 Then résultat = résultat + "s"
End If
'
'*** Conversion 1ère lettre en majuscule
résultat = UCase(Left(résultat, 1)) + Right(résultat, Len(résultat) - 1)
'
'*** renvoie du résultat de la fonction et fin de la fonction
Numlettre = résultat
Exit Function
'
centaine_dizaine: '*** Sous-programme de conversion en lettres
'*** des centaines et dizaines
varlet = ""
'
'*** Traitement des centaines
If varnum >= 100 Then
varlet = chiffre(Int(varnum / 100))
varnum = varnum Mod 100
If varlet = "un" Then
varlet = "cent "
Else
varlet = varlet + " cent "
End If
End If
'
'*** Traitement des dizaines
If varnum <= 19 Then '*** Cas où la dizaine est <20
If varnum > 0 Then varlet = varlet + chiffre(varnum)
Else '*** Autres cas
varnumD = Int(varnum / 10) '*** chiffre des dizaines
varnumU = varnum Mod 10 '*** chiffre des unités
Select Case varnumD '*** génération des dizaines en lettres
Case Is <= 5
varlet = varlet + dizaine(varnumD)
Case 6, 7
varlet = varlet + dizaine(6)
Case 8, 9
varlet = varlet + dizaine(8)
End Select
'
'*** traitement du séparateur des dizaines et unités
If varnumU = 1 And varnumD < 8 Then
varlet = varlet + " et "
Else
If varnumU <> 0 Or varnumD = 7 Or varnumD = 9 Then
varlet = varlet + " "
End If
End If
'*** génération des unités
If varnumD = 7 Or varnumD = 9 Then varnumU = varnumU + 10
If varnumU <> 0 Then varlet = varlet + chiffre(varnumU)
End If
'
'*** Suppression des espaces à gauche et retour
varlet = RTrim(varlet)
Return
erreur_montant:
Numlettre = ""
Exit Function
End Function
Private Sub Text1_Change()
NombresEnLettresAR (Form1.Text1)
NombresEnLettresFR (Form1.Text1)
Form1.Text2 = Lettres
Form1.Text3 = Numlettre
End Sub
Private Sub Íæá_Click()
NombresEnLettresAR (Form1.Text1)
Form1.Text2 = Lettres
End Sub
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.