Concertire un chiffre en lettre

Signaler
-
Messages postés
4
Date d'inscription
mercredi 7 janvier 2009
Statut
Membre
Dernière intervention
3 mai 2010
-
je cherche comment ecrire les totaux d une facture en lettreun grand merci a tous ceux qui viennent pour m aider.

4 réponses

Messages postés
4
Date d'inscription
mercredi 7 janvier 2009
Statut
Membre
Dernière intervention
3 mai 2010

Function NombresEnLettres_EURO(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("UN", "DEUX", "TROIS", "QUATRE", "CINQ", "SIX", "SEPT", "HUIT", "NEUF")
    Dizaine = Array("DIX", "VINGT", "TRENTE", "QUARANTE", "CINQUANTE", "SOIXANTE", "SOIXANTE", "QUATRE-VINGT", "QUATRE-VINGT")
    CasPart = Array("DIX", "ONZE", "DOUZE", "TREIZE", "QUATORZE", "QUINZE", "SEIZE")
   
' 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 = "ZERO"
        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
        Lettres = Lettres & " EUROS "
    Else
        Lettres = Lettres & " EURO "
    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 & " CENT"
        Case Is > 1
            Lettres = Lettres & " CENTS"
    End Select

' Renvoi du nombre traduit en lettres
    NombresEnLettres_EURO = 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 = "MILLE"
        Case 1000000 To 999999999
            Rank = Fix(Nombre / 1000000)
            Reste = Nombre Mod 1000000
            If Rank > 1 Then
                Nom_Rang = "MILLIONS"
            Else
                Nom_Rang = "MILLION"
            End If
        Case Is > 999999999
            Rank = Fix(Nombre / 1000000000)
            Reste = Nombre - Rank * 1000000000
            If Rank > 1 Then
                Nom_Rang = "MILLIARDS"
            Else
                Nom_Rang = "MILLIARD"
            End If
    End Select
   
' Traitement du rang des milliers, millions ou milliards
    Select Case Rank
        Case 1
            If Nom_Rang = "MILLE" Then
                Lettres = Lettres & Nom_Rang
            Else
                Lettres = Lettres & Unité(CInt(Rank)) & " " & Nom_Rang
            End If
        Case 2 To 9
            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
    End Select
   
    Lettres = Lettres

End Sub

'
' -----------------------------------
' TRAITEMENT DES NOMBRES DE 100 à 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
        Lettres = Lettres & "CENT"
    Else
        If Reste = 0 And Cent_Pluriel Then
            Lettres = Lettres & Unité(CInt(Rank)) & " " & "CENTS"
        Else
            Lettres = Lettres & Unité(CInt(Rank)) & " " & "CENT"
        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 à 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
            If Reste < 7 Then
                ' Nombres 10 à 16
                Lettres = Lettres & CasPart(Reste + 1)
            Else
                ' Nombres 17 à 19
                Lettres = Lettres & Dizaine(Rank) & "-" & Unité(CInt(Reste))
            End If
        Case 7
            Select Case Reste
                Case 0
                    ' Nombre 70
                    Lettres = Lettres & Dizaine(Rank) & "-" & Dizaine(Reste + 1)
                Case 1
                    ' Nombre 71
                    Lettres = Lettres & Dizaine(Rank) & " ET " & CasPart(Reste + 1)
                Case Else
                    If Reste < 7 Then
                    ' Nombres 72 à 76
                        Lettres = Lettres & Dizaine(Rank) & "-" & CasPart(Reste + 1)
                    Else
                    ' Nombres 77 à 79
                        Lettres = Lettres & Dizaine(Rank) & "-" & CasPart(1) & "-" & Unité(CInt(Reste))
                    End If
            End Select
        Case 8
            Lettres = Lettres & Dizaine(Rank)
            If Reste = 0 Then
                ' Nombre 80
                If Vingt_Pluriel Then
                    Lettres = Lettres & "S"
                End If
            Else
                ' Nombres 81 à 89
                Lettres = Lettres & "-" & Unité(CInt(Reste))
            End If
        Case 9
            If Reste < 7 Then
                ' Nombres 90 à 96
                Lettres = Lettres & Dizaine(Rank) & "-" & CasPart(Reste + 1)
            Else
                ' Nombres 97 à 99
                Lettres = Lettres & Dizaine(Rank) & "-" & CasPart(1) & "-" & Unité(CInt(Reste))
            End If
        Case Else
            ' Nombres 20 à 69
            Select Case Reste
                Case 0
                    ' Nombres 20, 30, 40, 50, 60
                    Lettres = Lettres & Dizaine(Rank)
                Case 1
                    ' Nombres 21, 31, 41, 51, 61
                    Lettres = Lettres & Dizaine(Rank) & " ET " & Unité(CInt(Reste))
                Case Else
                    ' Autres nombres
                    Lettres = Lettres & Dizaine(Rank) & "-" & Unité(CInt(Reste))
            End Select
    End Select
   
End Sub
C'est pas moi quie ecrire l'algo
Messages postés
7
Date d'inscription
jeudi 29 avril 2010
Statut
Membre
Dernière intervention
18 mai 2010

merci pour l'algo abdessalamanouar! ça m'a vraiment aidé.
j'ai tout simplement modifié l'initialisation des tableaux en mettant les "" au début de chaque tableau.
bonne journée!
Messages postés
7
Date d'inscription
jeudi 29 avril 2010
Statut
Membre
Dernière intervention
18 mai 2010

merci pour l'algo abdessalamanouar! ça m'a vraiment aidé.
j'ai tout simplement modifié l'initialisation des tableaux en mettant les "" au début de chaque tableau.
bonne journée!
Messages postés
4
Date d'inscription
mercredi 7 janvier 2009
Statut
Membre
Dernière intervention
3 mai 2010

2r1 mairyam ^^ bonne chance