Nombre en lettres

Télécharger le projet
Commenter

Description

Plusieurs démo du même style sont disponibles mais je constate qu'elles sont toutes, soit limitée, soit ne respecte pas fidèlement la syntaxe.
Cette démo transforme un nombre en lettres jusque 999 Billions avec 2 décimales si une devise est sélectionnée, jusque 0.000000009 si pas de devise.
Respecte toutes les règles de la syntaxe de la langue française. (Jusqu'à infirmation de votre part)
Le code ci-dessous est dispo dans tout les VB. Donc pas d'exemple exploitable directement.
Le zip contient plusieurs répertoires distincts...

Un classeur démo, Classeur Excel 97 - 03
Si vous n'êtes pas membre club vous pouvez le Télécharger sur
http://www.archive-host.com/link/dc3fd768dd0efbd8cd489c274f861c609cda3e45.xls Nombre_en_lettre_2000.xls

Un classeur démo, Classeur Excel 2007 et >
Si vous n'êtes pas membre club vous pouvez le Télécharger sur
http://www.archive-host.com/link/8fe14cef97be2e262a84217a51ab0f00fe51cc1d.xlsm Nombre_en_lettre.xlsm]

Une macro complémentaire, Excel 97 ? 03 (mode d?emploi inclus)
Si vous n'êtes pas membre club vous pouvez le Télécharger sur
http://www.archive-host.com/link/a65c95deda01e5b041fe3a0caac7d1c8c2f8b803.zip Macro_complementaire_XL_97_-_03.zip

Une macro complémentaire, Excel 2007 et > (mode d?emploi inclus)
Si vous n'êtes pas membre club vous pouvez le Télécharger sur
http://www.archive-host.com/link/9c813375f1d91c8febabc8ca386074cd0f17a30a.zip Macro_complementaire_XL_2007.zip

Projet VB6 Nombre en lettre
Si vous n'êtes pas membre club vous pouvez le Télécharger sur
http://www.archive-host.com/link/6256e1fcc5b8b239670a0c482127ec0e67315bc0.zip VB6_Nombre_en_lettre.zip

Projet VB 2010 Nombre en lettre
Si vous n'êtes pas membre club vous pouvez le Télécharger sur
http://www.archive-host.com/link/449893239b374e9d1c703ce4fd949800f7004aa5.zip Projet_VB_2010_Nombre_en_lettre.zip

Source / Exemple : 


'Module 1
Option Explicit
Public sep As String

Public Pays As Byte
Dim Decim As String, Stade As Integer
Dim strResultat(6) As String
Dim Reste As Single
Dim StrReste As String
Dim Devize As String
Public Unite(19) As String
Public Monnaie(7) As String
Public Dixaines(2 To 9) As String
Dim ValNb(6) As Double
Dim mStrTemp As String

Function EnTexte(Chiffre As Double, Optional Langue As Byte = 0, Optional Devise As Byte = 0, Optional Decimale As Byte = 0) As String
Dim i As Integer, txt As String
Dim strTemp As String
Dim a As String, Nombre As String, TB, P As String
    If Chiffre = 0 Then EnTexte = "Zéro": Exit Function
    Nombre = CStr(Chiffre)
    If Decimale = 0 Or Int(Chiffre) = Chiffre Then
        Nombre = Arrondi(Nombre, 0)
        Reste = 0
        If Int(Chiffre) = 0 And Reste = 0 Then EnTexte = "Zéro": Exit Function
    Else
        TB = Split(CStr(Chiffre), sep)
        Reste = TB(1) / 10 ^ Len(TB(1)) 'pour 2 décimales
        StrReste = TB(1) 'si pas de devise, met toutes les décimales
        If Chiffre < 1 Then
            strTemp = "Zéro "
            GoTo PasUnite
        End If
        Nombre = Int(Chiffre)
    End If
    Pays = Langue
    If Unite(1) = "" Then InitVar
    InitPays
reco:
    If Len(Nombre) / 3 <> Int(Len(Nombre) / 3) Then
        Nombre = "0" & Nombre
        GoTo reco
    End If
    Stade = (Len(Nombre) / 3)
    For i = 0 To Stade - 1
        txt = Mid(Nombre, (i * 3) + 1, 3)
        ValNb(i) = Val(txt)
        strResultat(i) = Centaine(txt)
    Next i
    i = 0
    If Stade > 4 Then 'Billiard
        If strResultat(i) <> "" Then
            strTemp = strTemp & VoirRegle(strResultat(i)) & IIf(ValNb(i) = 1, "Billiard ", "Billiards ")
        End If
        i = i + 1
    End If
    If Stade > 3 Then 'Milliard
        If strResultat(i) <> "" Then
            strTemp = strTemp & VoirRegle(strResultat(i)) & IIf(ValNb(i) = 1, "Milliard ", "Milliards ")
        End If
        i = i + 1
    End If
    If Stade > 2 Then 'Million
        If strResultat(i) <> "" Then
            strTemp = strTemp & VoirRegle(strResultat(i)) & IIf(ValNb(i) = 1, "Million ", "Millions ")
        End If
        i = i + 1
    End If
    If Stade > 1 Then 'millier
        If strResultat(i) <> "" Then
            If strResultat(i) = "un " Then
                strTemp = strTemp & "Mille "
            Else
                strTemp = strTemp & VoirRegle(strResultat(i)) & "Mille "
            End If
        End If
        i = i + 1
    End If
    If Stade > 0 Then 'les unités
        If strResultat(i) <> "" Then
            If strTemp <> "" And ValNb(i) < 100 And (Right(strResultat(i), 3) <> "un " Or Len(strResultat(i)) = 3) Then
            TB = Split(strTemp, " ")

            Select Case TB(UBound(TB) - 1)
            Case "Million", "Millions", "Milliard", "Milliards", "Billiard", "Billiards"
                strTemp = strTemp & "et "
            End Select
            End If
            strTemp = strTemp & VoirRegle(strResultat(i), False)
        End If
    End If
    TB = Split(strTemp, " ")
    Select Case TB(UBound(TB) - 1)
    Case "Million", "Millions", "Milliard", "Milliards", "Billiard", "Billiards"
        Select Case Devise
        Case 1, 3: strTemp = strTemp & "de "
        Case 2: strTemp = strTemp & "d'"
        End Select
    End Select
PasUnite:
    Select Case Devise
    Case Is > 0: strTemp = strTemp & Monnaie(Devise) & IIf(Nombre = 1, " ", "s ")
    End Select
    If Reste <> 0 And Decimale = 1 Then
        If Devise = 0 Then
            strTemp = strTemp & "Virgule "
            'Appel pour les décimales en base 3
            strTemp = strTemp & AprVirgule(StrReste)
        Else:
            strTemp = strTemp & " " & P
            Reste = Int(Reste * 1000) / 10
            ValNb(1) = Arrondi(Reste, 0)
            If ValNb(1) = 100 Then 'rectifie 100 centimes
                strTemp = EnTexte(Arrondi(Chiffre, 0), Pays, Devise, 0)
            Else
                txt = Right("00" & Trim(Str(ValNb(1))), 3)
                txt = Centaine(txt): txt = Trim(txt) & " "
                strTemp = strTemp & VoirRegle(txt)
                strTemp = strTemp & Monnaie(Devise + 4) & IIf(ValNb(1) = 1, "", "s")
            End If
        End If
    End If
    EnTexte = strTemp
End Function

Private Function AprVirgule(Nombre As String) As String
Dim i As Integer, txt As String, strTemp As String, N
    N = Array("Millième", "Millionnième", "Milliardième")
reco:
    If Len(Nombre) / 3 <> Int(Len(Nombre) / 3) Then
        Nombre = Nombre & "0"
        GoTo reco
    End If
    Stade = (Len(Nombre) / 3)
    If Stade > 3 Then Stade = 3
    For i = 0 To Stade - 1
        txt = Mid(Nombre, (i * 3) + 1, 3)
        ValNb(i) = Val(txt)
        strResultat(i) = Centaine(txt)
    Next i
    For i = 0 To Stade - 1
        If strResultat(i) <> "" Then
            strTemp = strTemp & VoirRegle(strResultat(i)) & N(i) & IIf(ValNb(i) > 1, "s ", " ")
        End If
    Next i
    AprVirgule = strTemp
End Function

Private Function Centaine(Nombre As String) As String
Dim i As Integer, e(3) As Integer, a As String
Dim strBuff As String
    For i = 3 To 1 Step -1
        e(i) = Val(Mid(Nombre, i, 1))
    Next i
    e(0) = Val(Right(Nombre, 2))
    
    If e(3) = 1 Then
        If Pays = 0 Then
            If e(2) <= 7 Then strBuff = "et un " Else strBuff = Unite(e(3))
        Else
            If e(2) <> 8 Then strBuff = "et un " Else strBuff = Unite(e(3))
        End If
    Else
        strBuff = Unite(e(3))
    End If
    If e(0) < 20 Then
        strBuff = Unite(e(0))
    ElseIf e(0) < 70 Or (e(0) > 79 And e(0) < 90) Or Pays <> 0 Then
        If e(3) > 0 And Left(strBuff, 2) <> "et" Then
            strBuff = Trim(Dixaines(e(2))) & "-" & LTrim(strBuff)
        ElseIf strBuff <> "" Then
            strBuff = Dixaines(e(2)) & strBuff
        Else
            strBuff = Dixaines(e(2))
        End If
    Else
        If e(0) > 89 Then i = 80 Else i = 60
        If e(3) = 1 And e(2) = 7 Then
            strBuff = RTrim(Dixaines(e(2) - 1)) & " " & "et onze "
        Else
            strBuff = RTrim(Dixaines(e(2) - 1)) & "-" & Unite(e(0) - i)
        End If
    End If
    
    'Centaine
    If e(1) = 1 Then
        strBuff = "cent " & strBuff
    ElseIf e(1) >= 1 Then
        If e(0) = 0 Then a = "cents " Else a = "cent "
        strBuff = Unite(e(1)) & "cent " & strBuff
    End If
    Centaine = strBuff
End Function
Private Function Arrondi(ByVal Nombre, ByVal Decimales)
      Arrondi = Int(Nombre * 10 ^ Decimales + 1 / 2) / 10 ^ Decimales
End Function

Private Function VoirRegle(V As String, Optional Stde As Boolean = True) As String
        If Right(V, 6) = "vingt " Then
            If Stde Then
                VoirRegle = V
            ElseIf Len(V) > 6 Then
                VoirRegle = RTrim(V) & "s "
            Else
                VoirRegle = V
            End If
        ElseIf Right(V, 4) = "ent " Then
            If Stde Then
                VoirRegle = V
            ElseIf Len(V) > 5 Then
                VoirRegle = RTrim(V) & "s "
            Else
                VoirRegle = V
            End If
        Else
            VoirRegle = V
        End If
End Function

'Module 2
Option Explicit

Public Sub InitVar()
Unite(0) = "":          Unite(1) = "un ":       Unite(2) = "deux ":     Unite(3) = "trois ":    Unite(4) = "quatre "
Unite(5) = "cinq ":     Unite(6) = "six ":      Unite(7) = "sept ":     Unite(8) = "huit ":     Unite(9) = "neuf "
Unite(10) = "dix ":     Unite(11) = "onze ":    Unite(12) = "douze ":   Unite(13) = "treize ":  Unite(14) = "quatorze "
Unite(15) = "quinze ":  Unite(16) = "seize ":   Unite(17) = "dix-sept ": Unite(18) = "dix-huit ": Unite(19) = "dix-neuf "

Dixaines(2) = "vingt ": Dixaines(3) = "trente ": Dixaines(4) = "quarante ": Dixaines(5) = "cinquante ": Dixaines(6) = "soixante "

Monnaie(0) = "": Monnaie(1) = "Dollar": Monnaie(2) = "Euro": Monnaie(3) = "Franc"
Monnaie(4) = "": Monnaie(5) = "Cent": Monnaie(6) = "Centime": Monnaie(7) = "Centime"
End Sub

Sub InitPays()
    Select Case Pays
    Case 0 'France
        Dixaines(7) = "soixante-dix "
        Dixaines(8) = "quatre-vingt "
        Dixaines(9) = "quatre-vingt-dix "
    Case 1 'Belge
        Dixaines(7) = "septante "
        Dixaines(8) = "quatre-vingt "
        Dixaines(9) = "nonante "
    Case 2 'suisse
        Dixaines(7) = "septante "
        Dixaines(8) = "huitante "
        Dixaines(9) = "nonante "
    End Select
End Sub

Conclusion :


Je pense que maintenant c'est complet.
Hésitez pas sur la critique.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (cs_lermite222)