Transformer un chiffre en lettre ex: 110 => cent dix


Télécharger le projet
Commenter

Description

Comment puis-je transformer un Nombre ( ex : 110 ) en toutes lettres ( ex : Cent dix ) ?

Créez un Formulaire avec 2 TextBox (Text1 et Text2) ainsi qu'un bouton (Command1)
Dans Text1 il y aura le Nombre (ex:110) et Dans Text2 le résultat (ex:Cent dix)

Mettez ce code dans un Module :

Source / Exemple : 


Public Function NbVersTexte(ValNum As Double) As String
    Static Unites(0 To 9) As String
    Static Dixaines(0 To 9) As String
    Static LesDixaines(0 To 9) As String
    Static Milliers(0 To 4) As String
    
    Dim i As Integer
    Dim nPosition As Integer
    Dim ValNb As Integer
    Dim LesZeros As Integer
    Dim strResultat As String
    Dim strTemp As String
    Dim tmpBuff As String
    
    Unites(0) = "zero"
    Unites(1) = "un"
    Unites(2) = "deux"
    Unites(3) = "trois"
    Unites(4) = "quatre"
    Unites(5) = "cinq"
    Unites(6) = "six"
    Unites(7) = "sept"
    Unites(8) = "huit"
    Unites(9) = "neuf"

    Dixaines(0) = "dix"
    Dixaines(1) = "onze"
    Dixaines(2) = "douze"
    Dixaines(3) = "treize"
    Dixaines(4) = "quatorze"
    Dixaines(5) = "quinze"
    Dixaines(6) = "seize"
    Dixaines(7) = "dix-sept"
    Dixaines(8) = "dix-huit"
    Dixaines(9) = "dix-neuf"

    LesDixaines(0) = ""
    LesDixaines(1) = "dix"
    LesDixaines(2) = "vingt"
    LesDixaines(3) = "trente"
    LesDixaines(4) = "quarante"
    LesDixaines(5) = "cinquante"
    LesDixaines(6) = "soixante"
    LesDixaines(7) = "soixante-dix"
    LesDixaines(8) = "quatre-vingt"
    LesDixaines(9) = "quatre-vingt-dix"

    Milliers(0) = ""
    Milliers(1) = "mille"
    Milliers(2) = "million"
    Milliers(3) = "millard"
    Milliers(4) = "mille"

    On Error GoTo NbVersTexteError
    
    strTemp = CStr(Int(ValNum))
    
    For i = Len(strTemp) To 1 Step -1
        ValNb = Val(Mid$(strTemp, i, 1))
        nPosition = (Len(strTemp) - i) + 1
        Select Case (nPosition Mod 3)
            Case 1
                LesZeros = False
                If i = 1 Then
                    If ValNb > 1 Then
                        tmpBuff = Unites(ValNb) & " "
                    Else
                        tmpBuff = ""
                    End If
                ElseIf Mid$(strTemp, i - 1, 1) = "1" Then
                    tmpBuff = Dixaines(ValNb) & " "
                    i = i - 1
                ElseIf Mid$(strTemp, i - 1, 1) = "9" Then
                    tmpBuff = LesDixaines(8) & " " & Dixaines(ValNb) & " "
                    i = i - 1
                ElseIf Mid$(strTemp, i - 1, 1) = "7" Then
                    tmpBuff = LesDixaines(6) & " " & Dixaines(ValNb) & " "
                    i = i - 1
                ElseIf ValNb > 0 Then
                    tmpBuff = Unites(ValNb) & " "
                Else
                    LesZeros = True
                    If i > 1 Then
                        If Mid$(strTemp, i - 1, 1) <> "0" Then
                            LesZeros = False
                        End If
                    End If
                    If i > 2 Then
                        If Mid$(strTemp, i - 2, 1) <> "0" Then
                            LesZeros = False
                        End If
                    End If
                    tmpBuff = ""
                End If
                If LesZeros = False And nPosition > 1 Then
                    tmpBuff = tmpBuff & Milliers(nPosition / 3) & " "
                End If
                strResultat = tmpBuff & strResultat
            Case 2
                If ValNb > 0 Then
                            strResultat = LesDixaines(ValNb) & " " & strResultat
                End If
            Case 0
                If ValNb > 0 Then
                    If ValNb > 1 Then
                        strResultat = Unites(ValNb) & " cent " & strResultat
                    Else
                        strResultat = "cent " & strResultat
                    End If
                End If
        End Select
    Next i
    If Len(strResultat) > 0 Then
        strResultat = UCase$(Left$(strResultat, 1)) & Mid$(strResultat, 2)
    End If

EndNbVersTexte:
    NbVersTexte = strResultat
    Exit Function

NbVersTexteError:
    strResultat = "Une Erreur !"
    Resume EndNbVersTexte
End Function

' Puis pour l'utiliser mettez ce code dans votre Formulaire

Private Sub Command1_Click()
    Text2.Text = NbVersTexte(Text1.Text)
End Sub

' N.B : Ce code à été adapté du code de Jim Youmans pour être utiliser en francais car les chiffres comme 75 et 95 ne s'affiche pas de la même façon.
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 (Nix)