Conversion des numbres arabe en toute lettres

Soyez le premier à donner votre avis sur cette source.

Vue 21 265 fois - Téléchargée 2 770 fois

Description

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

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

cs_Amazing
Messages postés
35
Date d'inscription
lundi 23 juin 2003
Statut
Membre
Dernière intervention
17 avril 2010
1 -
Bonjour sder
à ce que j'ai pu appercevoir ,ton code n'est pas de .NET
:-) ,(déchoche la Case)

Salutations
cs_frop01
Messages postés
1356
Date d'inscription
lundi 27 octobre 2003
Statut
Membre
Dernière intervention
19 novembre 2008
1 -
Très très utile comme code pour une gestion de facturation en arabe ;)

Je te mets une note 10/10 parsque je peut pas mettre 20/10 ;)
cs_frop01
Messages postés
1356
Date d'inscription
lundi 27 octobre 2003
Statut
Membre
Dernière intervention
19 novembre 2008
1 -
juste une ptite précision, c'est que l'unité décimale est en millimes et pas les milliers tu drevais lui ajouté l'unité Dinar.
sder0202
Messages postés
6
Date d'inscription
mercredi 28 juillet 2004
Statut
Membre
Dernière intervention
23 septembre 2008
-
Merci pour la note :)
Oui il y a des chose a modifier :
pour l'unité dicimal je vais faire la modif
pour lunite je le laisse ouvert Dinar Dirhem Riel ou autre c'est a personalisé !
brenntengel
Messages postés
49
Date d'inscription
jeudi 10 juin 2004
Statut
Membre
Dernière intervention
6 mai 2006
-
je suis debutant en VB je connais pas grand chose
et j'aprcie bq ton code.(je vais essayer de le comprendre)

Vraiment Chapeau !!!!

Exellent travail et bonne PROG .... ;-)

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.