Convertir un nombre en lettres

Commenter

Contenu du snippet

ce code peu être inséré comme fonction dans excell ou dans word, mais dans ce dernier cas la macro l'accompgnant est necessaire.
ce code n'est pas .net

Source / Exemple : 


Private Function StrFnUnités(StrUnité As String) As String
'traite les nombres à un seul chiffre
Dim StrUnit As String
StrUnit = ""
If Not IsNull(StrUnité) And StrUnité <> "0" Then
Select Case StrUnité
Case "1": StrUnit = "un"
Case "2": StrUnit = "deux"
Case "3": StrUnit = "trois"
Case "4": StrUnit = "quatre"
Case "5": StrUnit = "cinq"
Case "6": StrUnit = "six"
Case "7": StrUnit = "sept"
Case "8": StrUnit = "huit"
Case "9": StrUnit = "neuf"
End Select
StrFnUnités = StrUnit
End If

End Function

Private Function StrFnDizaines(StrDizaine As String) As String
'traite les nombres à deux chiffres mais inférieurs à 20
Dim StrDiz As String
StrDiz = ""
If Not IsNull(StrDizaine) And CInt(StrDizaine) < 20 And CInt(StrDizaine) > 9 Then
Select Case StrDizaine
Case "10": StrDiz = "dix"
Case "11": StrDiz = "onze"
Case "12": StrDiz = "douze"
Case "13": StrDiz = "treize"
Case "14": StrDiz = "quatorze"
Case "15": StrDiz = "quinze"
Case "16": StrDiz = "seize"
Case "17": StrDiz = "dix-sept"
Case "18": StrDiz = "dix-huit"
Case "19": StrDiz = "dix-neuf"
End Select
StrFnDizaines = StrDiz
End If
End Function

Private Function StrFnDizaineBis(StrDizaineBis As String) As String
'traite les nombres à deux chiffres mais supérieurs à 20
Dim StrEspace, StrEt  As String
StrEspace = " "
'StrEt = "et"
Dim StrDizBis As String

Dim StrPremChiff, StrSecChiff As String
Dim StrMesDizaines, StrMesUnités As String
Dim IntSeptante  As Integer, StrEspSept, StrDroitSept As String

StrPremChiff = Left(CStr(StrDizaineBis), 1)
StrSecChiff = Right(CStr(StrDizaineBis), 1)
StrDizBis = ""

If Not IsNull(StrPremChiff) And StrPremChiff <> "0" Then
    If StrPremChiff <> 1 Then
    Select Case StrPremChiff
        Case "2": StrDizBis = "vingt"
        Case "3": StrDizBis = "trente"
        Case "4": StrDizBis = "quarante"
        Case "5": StrDizBis = "cinquante"
        Case "6": StrDizBis = "soixante"
        Case "7": StrDizBis = "soixante" 'ce n'est pas septante
        Case "8": StrDizBis = "quatre-vingt" 'ce n'est pas huitante
        Case "9": StrDizBis = "quatre-vingt" 'ce n'est pas neunante
    End Select
    If StrPremChiff <> "7" And StrPremChiff <> "9" Then
        StrMesDizaines = StrDizBis
        StrMesUnités = StrFnUnités((StrSecChiff))
            If StrMesUnités <> "un" Then
                StrFnDizaineBis = StrDizBis & StrEspace & StrMesUnités
            Else
                StrFnDizaineBis = StrDizBis & StrEspace & StrEt & StrEspace & StrMesUnités
            End If
    Else
        IntSeptante = CInt(StrSecChiff) + 10
        StrDroitSept = Right(CStr(IntSeptante), 1)
        StrEspSept = CStr(IIf(StrDroitSept = 1, StrEt & StrEspace, ""))
        
        StrFnDizaineBis = StrDizBis & StrEspace & StrEspSept & StrFnDizaines((IntSeptante))
    End If

Else
StrFnDizaineBis = StrFnDizaines(StrDizaineBis)
End If

End If

End Function

Private Function StrFnTroisChiff(StrNbrTrois As String) As String
'traite les nombres à trois chiffres (centaine(s))
Dim StrPremChiff, StrLastChiff As String
Dim StrCentaine, StrCentaines, StrMesDizaines As String
Dim StrEspace, StrCents, StrCent As String

StrCent = "cent"
StrCents = "cents"
StrEspace = " "

StrPremChiff = Left(CStr(StrNbrTrois), 1)
    If StrPremChiff <> "0" And StrPremChiff <> "" Then
            StrCentaine = StrFnUnités((StrPremChiff))
            If StrCentaine <> "un" Then
                StrCentaines = StrCentaine & StrEspace & StrCents & StrEspace
            Else
                StrCentaines = StrCent & StrEspace
            End If
    End If
StrLastChiff = Right(CStr(StrNbrTrois), 2)

If Mid(CStr(StrNbrTrois), 2, 1) <> "0" Then
    StrMesDizaines = StrFnDizaineBis(StrLastChiff)
    Else
    StrLastChiff = Right(CStr(StrNbrTrois), 1)
    StrMesDizaines = StrFnUnités(StrLastChiff)
End If
    'StrCentaines = StrCentaines & StrMesDizaines
    StrCentaines = IIf(StrPremChiff <> "0" And StrPremChiff <> "", StrCentaines & StrMesDizaines, StrMesDizaines)
StrFnTroisChiff = StrCentaines

End Function

Public Function StrFnMain(DblLesNombres As Double) As String
'fonction principale
Dim StrRésultat As String
Dim DblPartiEntière As Double
Dim IntLongGén As Integer
Dim StrMille, StrEspace, StrPlur, StrMillion, StrMilliard As String
Dim StrFirstChiff, StrAutresChiff, StrMillierChiff As String
Dim StrMonMillier, StrMesTroisChiffres, StrMonMillion, StrMesMillions, StrMesMilliers, StrMonMilliard As String
Dim StrMillionChiff As String
Dim IntCentime As Integer, StrMesCentimes, StrQtéCentimes As String
Dim StrEt As String
StrEt = "et"
StrPlur = "s"
StrMille = "mille"
StrEspace = " "
StrRésultat = ""
StrMillion = "million"
StrMilliard = "milliard"

DblConvNombre = Round(DblLesNombres, 2)
IntCentime = 100 * (DblLesNombres - Fix(DblConvNombre))

If CStr(IntCentime) = "00" Or CStr(IntCentime) = "" Or CStr(IntCentime) = "0" Then
    StrMesCentimes = ""
    Else
    StrMesCentimes = IIf(IntCentime < 10, StrFnUnités(CStr(IntCentime)), StrFnDizaineBis((CStr(IntCentime))))
    StrQtéCentimes = StrEspace & StrEt & StrEspace & StrMesCentimes & StrEspace & "Centime"
    StrMesCentimes = IIf(StrMesCentimes <> "un", StrQtéCentimes & "s", StrQtéCentimes)
    
End If

If Not IsNull(DblConvNombre) And DblConvNombre <> 0 Then

DblPartiEntière = Fix(DblConvNombre)
IntLongGén = CInt(Len(CStr(DblPartiEntière)))

Select Case IntLongGén
    Case 1
        StrRésultat = StrFnUnités((DblPartiEntière))
    Case 2
        StrRésultat = StrFnDizaineBis((DblPartiEntière))
    Case 3
        StrRésultat = StrFnTroisChiff((DblPartiEntière))
    Case 4
        StrFirstChiff = Left(CStr(DblPartiEntière), 1)
        StrAutresChiff = Mid(CStr(DblPartiEntière), 2, 3)

        StrMonMillier = CStr(IIf(StrFnUnités((StrFirstChiff)) <> "un", StrFnUnités((StrFirstChiff)) & StrEspace, ""))
        StrMesTroisChiffres = StrFnTroisChiff((StrAutresChiff))
        'StrPlur = CStr(IIf(StrFirstChiff = 1, "", "s")), les mille ne prennent jamais de s
        StrRésultat = StrMonMillier & StrMille & StrEspace & StrMesTroisChiffres
    Case 5
        StrFirstChiff = Left(CStr(DblPartiEntière), 2)
        StrAutresChiff = Right(CStr(DblPartiEntière), 3)
        StrMonMillier = StrFnDizaineBis((StrFirstChiff)) & StrEspace
        StrMesTroisChiffres = StrFnTroisChiff((StrAutresChiff))
        StrRésultat = StrMonMillier & StrMille & StrEspace & StrMesTroisChiffres
    Case 6
        StrFirstChiff = Left(CStr(DblPartiEntière), 3)
        StrAutresChiff = Right(CStr(DblPartiEntière), 3)
        StrMonMillier = StrFnTroisChiff((StrFirstChiff)) & StrEspace
        StrMesTroisChiffres = StrFnTroisChiff((StrAutresChiff))
        StrRésultat = StrMonMillier & StrMille & StrEspace & StrMesTroisChiffres
    Case 7
        StrFirstChiff = Left(CStr(DblPartiEntière), 1)
        StrPlur = IIf(StrFirstChiff = 1, "", "s")
        StrMonMillion = StrFnUnités((StrFirstChiff)) & StrEspace & StrMillion & StrPlur
        StrMillierChiff = Mid(CStr(DblPartiEntière), 2, 3)
        'StrPlur = IIf(CInt(StrMillierChiff) <= 1, "", "s")
        StrMesMilliers = IIf(StrMillierChiff <> "000", StrFnTroisChiff((StrMillierChiff)) & StrEspace & StrMille, "")
        If Left(StrMesMilliers, 2) = "un" Then StrMesMilliers = Mid(StrMesMilliers, 4)
        StrAutresChiff = Right(CStr(DblPartiEntière), 3)
        StrMesTroisChiffres = StrFnTroisChiff((StrAutresChiff))
        StrRésultat = StrMonMillion & StrEspace & StrMesMilliers & StrEspace & StrMesTroisChiffres
    Case 8
        StrFirstChiff = Left(CStr(DblPartiEntière), 2)
        StrMonMillion = StrFnDizaineBis((StrFirstChiff)) & StrEspace & StrMillion & StrPlur
        StrMillierChiff = Mid(CStr(DblPartiEntière), 3, 3)
        'StrPlur = IIf(CInt(StrMillierChiff) <= 1, "", "s")
        StrMesMilliers = IIf(StrMillierChiff <> "000", StrFnTroisChiff((StrMillierChiff)) & StrEspace & StrMille, "")
        If Left(StrMesMilliers, 2) = "un" Then StrMesMilliers = Mid(StrMesMilliers, 4)
        StrAutresChiff = Right(CStr(DblPartiEntière), 3)
        StrMesTroisChiffres = StrFnTroisChiff((StrAutresChiff))
        StrRésultat = StrMonMillion & StrEspace & StrMesMilliers & StrEspace & StrMesTroisChiffres
    Case 9
        StrFirstChiff = Left(CStr(DblPartiEntière), 3)
        StrMonMillion = StrFnTroisChiff((StrFirstChiff)) & StrEspace & StrMillion & StrPlur
        StrMillierChiff = Mid(CStr(DblPartiEntière), 4, 3)
        'StrPlur = IIf(CInt(StrMillierChiff) <= 1, "", "s")
        StrMesMilliers = IIf(StrMillierChiff <> "000", StrFnTroisChiff((StrMillierChiff)) & StrEspace & StrMille, "")
        If Left(StrMesMilliers, 2) = "un" Then StrMesMilliers = Mid(StrMesMilliers, 4)
        StrAutresChiff = Right(CStr(DblPartiEntière), 3)
        StrMesTroisChiffres = StrFnTroisChiff((StrAutresChiff))
        StrRésultat = StrMonMillion & StrEspace & StrMesMilliers & StrEspace & StrMesTroisChiffres
    Case 10
        StrFirstChiff = Left(CStr(DblPartiEntière), 1)
        StrPlur = IIf(StrFirstChiff = 1, "", "s")
        StrMonMilliard = StrFnUnités((StrFirstChiff)) & StrEspace & StrMilliard & StrPlur
        StrMillionChiff = Mid(CStr(DblPartiEntière), 2, 3)
        StrMesMillions = IIf(StrMillionChiff <> "000", StrFnTroisChiff((StrMillionChiff)) & StrEspace & StrMillion, "")
        StrPlur = IIf(CInt(StrMillionChiff) <= 1, "", "s")
        StrMesMillions = StrMesMillions & StrPlur
        StrMillierChiff = Mid(CStr(DblPartiEntière), 5, 3)
        StrMesMilliers = IIf(StrMillierChiff <> "000", StrFnTroisChiff((StrMillierChiff)) & StrEspace & StrMille, "")
        'StrPlur = IIf(CInt(StrMillierChiff) <= 1, "", "s")
        'StrMesMilliers = StrMesMilliers & StrPlur
        If Left(StrMesMilliers, 2) = "un" Then StrMesMilliers = Mid(StrMesMilliers, 4)
        StrAutresChiff = Right(CStr(DblPartiEntière), 3)
        StrMesTroisChiffres = StrFnTroisChiff((StrAutresChiff))
        StrRésultat = StrMonMilliard & StrEspace & StrMesMillions & StrEspace & StrMesMilliers & StrEspace & StrMesTroisChiffres
    Case 11
        StrFirstChiff = Left(CStr(DblPartiEntière), 2)
        StrMonMilliard = StrFnDizaineBis((StrFirstChiff)) & StrEspace & StrMilliard & StrPlur
        StrMillionChiff = Mid(CStr(DblPartiEntière), 3, 3)
        StrPlur = IIf(CInt(StrMillionChiff) <= 1, "", "s")
        StrMesMillions = IIf(StrMillionChiff <> "000", StrFnTroisChiff((StrMillionChiff)) & StrEspace & StrMillion & StrPlur, "")
        'If Left(StrMesMillions, 2) = "un" Then StrMesMillions = Mid(StrMesMillions, 4)
        StrMillierChiff = Mid(CStr(DblPartiEntière), 6, 3)
        StrMesMilliers = IIf(StrMillierChiff <> "000", StrFnTroisChiff((StrMillierChiff)) & StrEspace & StrMille, "")
        If Left(StrMesMilliers, 2) = "un" Then StrMesMilliers = Mid(StrMesMilliers, 4)
        StrAutresChiff = Right(CStr(DblPartiEntière), 3)
        StrMesTroisChiffres = StrFnTroisChiff((StrAutresChiff))
        StrRésultat = StrMonMilliard & StrEspace & StrMesMillions & StrEspace & StrMesMilliers & StrEspace & StrMesTroisChiffres
    Case 12
        StrFirstChiff = Left(CStr(DblPartiEntière), 3)
        StrMonMilliard = StrFnTroisChiff((StrFirstChiff)) & StrEspace & StrMilliard & StrPlur
        StrMillionChiff = Mid(CStr(DblPartiEntière), 4, 3)
        StrPlur = IIf(CInt(StrMillionChiff) <= 1, "", "s")
        StrMesMillions = IIf(StrMillionChiff <> "000", StrFnTroisChiff((StrMillionChiff)) & StrEspace & StrMillion & StrPlur, "")
        'If Left(StrMesMillions, 2) = "un" Then StrMesMillions = Mid(StrMesMillions, 4)
        StrMillierChiff = Mid(CStr(DblPartiEntière), 7, 3)
        StrMesMilliers = IIf(StrMillierChiff <> "000", StrFnTroisChiff((StrMillierChiff)) & StrEspace & StrMille, "")
        If Left(StrMesMilliers, 2) = "un" Then StrMesMilliers = Mid(StrMesMilliers, 4)
        StrAutresChiff = Right(CStr(DblPartiEntière), 3)
        StrMesTroisChiffres = StrFnTroisChiff((StrAutresChiff))
        StrRésultat = StrMonMilliard & StrEspace & StrMesMillions & StrEspace & StrMesMilliers & StrEspace & StrMesTroisChiffres
        
        
End Select
' Dirhams est la monnaie nationale.
StrFnMain = StrFnMajuscule(StrRésultat & " Dirhams" & StrMesCentimes)
End If

End Function

Private Function StrFnMajuscule(StrMinuscule As String) As String
'met en majuscule la première lettre du chiffre
Dim StrPremLetr As String
Dim IntPremLetr As Integer
Dim StrAutreLetr As String

StrPremLetr = Left(StrMinuscule, 1)
IntPremLetr = Asc(StrPremLetr) - 32
StrAutreLetr = Mid(StrMinuscule, 2)
StrFnMajuscule = Chr(IntPremLetr) & StrAutreLetr

End Function

'macro
Sub macro()
'
' Macro qui agit sur une sélection faite par l'utilisateur de word
'
    On Error GoTo ErrExécution

    Dim résultat As String
    If Documents.Count >= 1 Then 'éviter le click éventuel sur le bouton à la maco avant ouverture d'un fichier
    Set maselection = Selection.Range
    If IsNumeric(maselection) Then
    If maselection < 1000000000000# Then
    résultat = StrFnMain((maselection))
    maselection.InsertAfter " " & résultat
    Else
    MsgBox "Pardon, je ne sait pas compter plus que 999 999 999 999,99", vbInformation, "conversion de nombres en lettres"
    End If
    Else
    MsgBox maselection & " : n'est pas un chiffre valide", vbCritical, "conversion de nombres en lettres"
    End If
    End If
ExitErrExécution:
    Exit Sub

ErrExécution:
    If Err.Number = 438 Then
    MsgBox "sélectionnez avant d'appyuer sur ce bouton", vbExclamation, "conversion de nombres en lettres"
    Else
    MsgBox Err.Description & "   " & Err.Number
    End If
    Resume ExitErrExécution
End Sub

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 (max1980)