Procedure en VBA

BARK -  
 ZAZIE -
bonjour,
je cherche une procedure écrite en VBA qui permet de saisir un montant en chiffre et le convertir en lettre dans le cadre d'une facture.
Merci

2 réponses

  1. lami20j
     
    Salut,

    J'ai crée 2 fonctions dans VBA :

    ConversionNormale
    ConversionDecimale

    qui font la conversion des chiffres en lettres de façon suivante

    ConversionNormale de 1 à 999.999
    ConversionDecimale de 0,01 à 999.999,99

    euro(s) et ajouté à la fin

    Le code est assez long ( c'était mon début en VBA et dans la programmation) et je n'ai plus travaillé dessus. Peut-être tu vas trouver quelque chose plus simple.

    Voilà le code:

    ======================================================

    Option Explicit

    Const cent = "cent"
    Const cents = "cents"
    Const mille = "mille"
    Const euro = "euro"
    Const euros = "euros"
    Const centimes = "centimes"
    Const zero = "zero"

    Dim sConversionUnites As String
    Dim sConversionDisaines As String
    Dim sConversionCentaines As String
    Dim sConversionApresUnites As String
    Dim sMontant As String
    Dim sMontantMille As String
    Dim sMontantCentMille As String
    Dim sDecimale As String

    Public Sub Unites(sUnites As String)

    Select Case sUnites

    Case Is = 1
    sConversionUnites = "un"
    Case Is = 2
    sConversionUnites = "deux"
    Case Is = 3
    sConversionUnites = "trois"
    Case Is = 4
    sConversionUnites = "quatre"
    Case Is = 5
    sConversionUnites = "cinq"
    Case Is = 6
    sConversionUnites = "six"
    Case Is = 7
    sConversionUnites = "sept"
    Case Is = 8
    sConversionUnites = "huit"
    Case Is = 9
    sConversionUnites = "neuf"

    End Select

    End Sub

    Public Sub Disaines(sDisaines As String)
    ' Dim iLengthDisaines
    ' iLengthDisaines = 2
    'iLengthDisaines = Len(sDisaines)

    Select Case sDisaines

    Case Is = 1
    sConversionDisaines = "dix"
    Case Is = 2
    sConversionDisaines = "vingt"
    Case Is = 3
    sConversionDisaines = "trente"
    Case Is = 4
    sConversionDisaines = "quarante"
    Case Is = 5
    sConversionDisaines = "cinquante"
    Case Is = 6
    sConversionDisaines = "soixante"
    Case Is = 7
    sConversionDisaines = "soixante-dix"
    Case Is = 8
    sConversionDisaines = "quatre-vingt"
    Case Is = 9
    sConversionDisaines = "quatre-vingt-dix"

    End Select

    End Sub

    Public Sub ApresUnites(sApresUnites As String)

    Select Case sApresUnites

    Case Is = 11
    sConversionApresUnites = "onze"
    Case Is = 12
    sConversionApresUnites = "douze"
    Case Is = 13
    sConversionApresUnites = "treize"
    Case Is = 14
    sConversionApresUnites = "quatorze"
    Case Is = 15
    sConversionApresUnites = "quinze"
    Case Is = 16
    sConversionApresUnites = "seize"
    Case Is = 17
    sConversionApresUnites = "dix-sept"
    Case Is = 18
    sConversionApresUnites = "dix-huit"
    Case Is = 19
    sConversionApresUnites = "dix-neuf"

    End Select

    End Sub

    Private Function conversion(sMontant As String)

    Dim iLength As Integer
    iLength = Len(sMontant)

    Select Case iLength

    Case Is = 1
    Unites (sMontant)
    conversion = sConversionUnites

    Case Is = 2
    If Right(sMontant, 1) = 0 Then
    Disaines (Left(sMontant, 1))
    conversion = sConversionDisaines
    ElseIf Left(sMontant, 1) = 1 And Right(sMontant, 1) <> 0 Then
    ApresUnites (sMontant)
    conversion = sConversionApresUnites
    ElseIf Left(sMontant, 1) <> 0 And Left(sMontant, 1) <= 6 And Right(sMontant, 1) <> 0 Then
    Unites (Right(sMontant, 1))
    Disaines (Left(sMontant, 1))
    conversion = sConversionDisaines & " " & sConversionUnites

    ElseIf Left(sMontant, 1) <> 0 And Left(sMontant, 1) = 7 And Right(sMontant, 1) <> 0 Then
    Disaines (Left(sMontant, 1))
    ApresUnites ("1" & Right(sMontant, 1))
    conversion = Left(sConversionDisaines, 8) & " " & sConversionApresUnites
    ElseIf Left(sMontant, 1) <> 0 And Left(sMontant, 1) = 8 And Right(sMontant, 1) <> 0 Then
    Unites (Right(sMontant, 1))
    Disaines (Left(sMontant, 1))
    conversion = sConversionDisaines & " " & sConversionUnites
    ElseIf Left(sMontant, 1) <> 0 And Left(sMontant, 1) = 9 And Right(sMontant, 1) <> 0 Then
    Disaines (Left(sMontant, 1))
    ApresUnites ("1" & Right(sMontant, 1))
    conversion = Left(sConversionDisaines, 12) & " " & sConversionApresUnites
    End If

    Case Is = 3

    If Left(sMontant, 1) = 1 And Right(sMontant, 2) = 0 Then
    conversion = cent
    ElseIf Left(sMontant, 1) > 1 And Right(sMontant, 2) = 0 And Right(sMontant, 1) = 0 Then
    Unites (Left(sMontant, 1))
    conversion = sConversionUnites & " " & cent & "s"
    ElseIf Left(sMontant, 1) = 1 And Mid(sMontant, 2, 1) = 0 Then
    Unites (Right(sMontant, 1))
    conversion = cent & " " & sConversionUnites
    ElseIf Left(sMontant, 1) = 1 And Mid(sMontant, 2, 1) = 1 And Right(sMontant, 1) <> 0 Then
    ApresUnites (Mid(sMontant, 2, 2))
    conversion = cent & " " & sConversionApresUnites
    ElseIf Left(sMontant, 1) <> 1 And Right(sMontant, 1) = 0 Then
    Unites (Left(sMontant, 1))
    Disaines (Mid(sMontant, 2, 1))
    conversion = sConversionUnites & " " & cent & " " & sConversionDisaines
    ElseIf Left(sMontant, 1) = 1 And Right(sMontant, 1) = 0 Then
    'Unites (Left(sMontant, 1))
    Disaines (Mid(sMontant, 2, 1))
    conversion = cent & " " & sConversionDisaines
    ElseIf Left(sMontant, 1) = 1 And Mid(sMontant, 2, 1) <= 6 Then
    Disaines (Mid(sMontant, 2, 1))
    Unites (Right(sMontant, 1))
    conversion = cent & " " & sConversionDisaines & " " & sConversionUnites
    ElseIf Left(sMontant, 1) = 1 And Mid(sMontant, 2, 1) = 7 Then
    Disaines (Mid(sMontant, 2, 1))
    ApresUnites ("1" & Right(sMontant, 1))
    'Unites (Right(sMontant, 1))
    conversion = cent & " " & Left(sConversionDisaines, 8) & " " & sConversionApresUnites
    ElseIf Left(sMontant, 1) = 1 And Mid(sMontant, 2, 1) = 8 Then
    Disaines (Mid(sMontant, 2, 1))
    Unites (Right(sMontant, 1))
    conversion = cent & " " & sConversionDisaines & " " & sConversionUnites
    ElseIf Left(sMontant, 1) = 1 And Mid(sMontant, 2, 1) = 9 Then
    Disaines (Mid(sMontant, 2, 1))
    ApresUnites ("1" & Right(sMontant, 1))
    'Unites (Right(sMontant, 1))
    conversion = cent & " " & Left(sConversionDisaines, 12) & " " & sConversionApresUnites
    ElseIf Left(sMontant, 1) > 1 And Mid(sMontant, 2, 1) = 0 Then
    Unites (Left(sMontant, 1))
    conversion = sConversionUnites & " " & cent

    Unites (Right(sMontant, 1))
    conversion = conversion & " " & sConversionUnites
    ElseIf Left(sMontant, 1) > 1 And Mid(sMontant, 2, 1) = 1 Then
    Unites (Left(sMontant, 1))
    conversion = sConversionUnites & " " & cent
    ApresUnites ("1" & Right(sMontant, 1))
    conversion = conversion & " " & sConversionApresUnites

    ElseIf Left(sMontant, 1) > 1 And Mid(sMontant, 2, 1) <= 6 Then
    Unites (Left(sMontant, 1))
    conversion = sConversionUnites & " " & cent
    Disaines (Mid(sMontant, 2, 1))
    conversion = conversion & " " & sConversionDisaines
    Unites (Right(sMontant, 1))
    conversion = conversion & " " & sConversionUnites

    ElseIf Left(sMontant, 1) > 1 And Mid(sMontant, 2, 1) = 7 Then
    Unites (Left(sMontant, 1))
    conversion = sConversionUnites & " " & cent
    Disaines (Mid(sMontant, 2, 1))
    ApresUnites ("1" & Right(sMontant, 1))
    conversion = conversion & " " & Left(sConversionDisaines, 8) & " " & sConversionApresUnites
    ElseIf Left(sMontant, 1) > 1 And Mid(sMontant, 2, 1) = 8 Then
    Unites (Left(sMontant, 1))
    conversion = sConversionUnites & " " & cent
    Disaines (Mid(sMontant, 2, 1))
    Unites (Right(sMontant, 1))
    conversion = conversion & " " & sConversionDisaines & " " & sConversionUnites
    ElseIf Left(sMontant, 1) > 1 And Mid(sMontant, 2, 1) = 9 Then
    Unites (Left(sMontant, 1))
    conversion = sConversionUnites & " " & cent
    Disaines (Mid(sMontant, 2, 1))
    ApresUnites ("1" & Right(sMontant, 1))
    conversion = conversion & " " & Left(sConversionDisaines, 12) & " " & sConversionApresUnites

    End If
    End Select
    End Function

    Private Function ConversionMille(sMontantMille)
    Dim sMontantUnites As String, sMontantDisaines As String, sMontantCentaines As String
    Dim sMontantMilleConversion As String
    Dim iLengthMille As Integer
    Dim sConversionFunction As String
    iLengthMille = Len(sMontantMille)
    Dim sConversionMille As String

    Select Case iLengthMille

    Case Is = 4
    If Mid(sMontantMille, 2, 1) = 0 And Mid(sMontantMille, 3, 1) = 0 _
    And Mid(sMontantMille, 4, 1) = 0 Then
    Unites (Left(sMontantMille, 1))
    ConversionMille = sConversionUnites & " " & mille
    ElseIf Mid(sMontantMille, 2, 1) = 0 And Mid(sMontantMille, 3, 1) = 0 Then
    sMontantUnites = Right(sMontantMille, 1)
    Unites (Left(sMontantMille, 1))
    ConversionMille = sConversionUnites & " " & mille
    sConversionFunction = conversion(sMontantUnites)
    ConversionMille = ConversionMille & " " & sConversionFunction
    ElseIf Mid(sMontantMille, 2, 1) = 0 And Mid(sMontantMille, 3, 1) > 0 Then
    sMontantDisaines = Right(sMontantMille, 2)
    Unites (Left(sMontantMille, 1))
    ConversionMille = ""
    ConversionMille = sConversionUnites & " " & mille
    sConversionFunction = conversion(sMontantDisaines)
    ConversionMille = ConversionMille & " " & sConversionFunction
    ElseIf Mid(sMontantMille, 2, 1) > 0 Then
    sMontantCentaines = Right(sMontantMille, 3)
    Unites (Left(sMontantMille, 1))
    ConversionMille = ""
    ConversionMille = sConversionUnites & " " & mille
    sConversionFunction = conversion(sMontantCentaines)
    ConversionMille = ConversionMille & " " & sConversionFunction
    End If

    Case Is = 5
    If Mid(sMontantMille, 2, 1) = 0 And Mid(sMontantMille, 3, 1) = 0 _
    And Mid(sMontantMille, 4, 1) = 0 And Mid(sMontantMille, 5, 1) = 0 Then
    Disaines (Left(sMontantMille, 1))
    ConversionMille = sConversionDisaines & " " & mille
    ElseIf Mid(sMontantMille, 2, 1) > 0 And Mid(sMontantMille, 3, 1) = 0 _
    And Mid(sMontantMille, 4, 1) = 0 And Mid(sMontantMille, 5, 1) = 0 Then
    sMontantMilleConversion = Left(sMontantMille, 2)
    sConversionMille = conversion(sMontantMilleConversion)
    ConversionMille = sConversionMille & " " & mille
    ElseIf Mid(sMontantMille, 2, 1) = 0 And Mid(sMontantMille, 3, 1) = 0 _
    And Mid(sMontantMille, 4, 1) = 0 And Mid(sMontantMille, 5, 1) > 0 Then
    Disaines (Left(sMontantMille, 1))
    ConversionMille = sConversionDisaines & " " & mille
    sMontantUnites = Right(sMontantMille, 1)
    sConversionFunction = conversion(sMontantUnites)
    ConversionMille = ConversionMille & " " & sConversionFunction
    ElseIf Mid(sMontantMille, 2, 1) = 0 And Mid(sMontantMille, 3, 1) = 0 _
    And Mid(sMontantMille, 4, 1) > 0 And Mid(sMontantMille, 5, 1) >= 0 Then
    Disaines (Left(sMontantMille, 1))
    ConversionMille = sConversionDisaines & " " & mille
    sMontantDisaines = Right(sMontantMille, 2)
    sConversionFunction = conversion(sMontantDisaines)
    ConversionMille = ConversionMille & " " & sConversionFunction
    ElseIf Mid(sMontantMille, 2, 1) = 0 And Mid(sMontantMille, 3, 1) > 0 _
    And Mid(sMontantMille, 4, 1) >= 0 And Mid(sMontantMille, 5, 1) >= 0 Then

    Disaines (Left(sMontantMille, 1))
    ConversionMille = sConversionDisaines & " " & mille
    sMontantCentaines = Right(sMontantMille, 3)
    sConversionFunction = conversion(sMontantCentaines)
    ConversionMille = ConversionMille & " " & sConversionFunction
    ElseIf Left(sMontantMille, 1) = 1 And Mid(sMontantMille, 2, 1) > 0 And Mid(sMontantMille, 3, 1) = 0 _
    And Mid(sMontantMille, 4, 1) = 0 And Mid(sMontantMille, 5, 1) > 0 Then

    ApresUnites ("1" & Mid(sMontantMille, 2, 1))
    ConversionMille = sConversionApresUnites & " " & mille
    sMontantUnites = (Right(sMontantMille, 1))
    sConversionFunction = conversion(sMontantUnites)
    ConversionMille = ConversionMille & " " & sConversionFunction
    ElseIf Left(sMontantMille, 1) = 1 And Mid(sMontantMille, 2, 1) > 0 And Mid(sMontantMille, 3, 1) = 0 _
    And Mid(sMontantMille, 4, 1) > 0 And Mid(sMontantMille, 5, 1) >= 0 Then

    ApresUnites ("1" & Mid(sMontantMille, 2, 1))
    ConversionMille = sConversionApresUnites & " " & mille
    sMontantDisaines = (Right(sMontantMille, 2))
    sConversionFunction = conversion(sMontantDisaines)
    ConversionMille = ConversionMille & " " & sConversionFunction
    ElseIf Left(sMontantMille, 1) = 1 And Mid(sMontantMille, 2, 1) > 0 And Mid(sMontantMille, 3, 1) > 0 _
    And Mid(sMontantMille, 4, 1) >= 0 And Mid(sMontantMille, 5, 1) >= 0 Then

    ApresUnites ("1" & Mid(sMontantMille, 2, 1))
    ConversionMille = sConversionApresUnites & " " & mille
    sMontantCentaines = Right(sMontantMille, 3)
    sConversionFunction = conversion(sMontantCentaines)
    ConversionMille = ConversionMille & " " & sConversionFunction

    ElseIf Left(sMontantMille, 1) > 1 And Mid(sMontantMille, 2, 1) > 0 And Mid(sMontantMille, 3, 1) = 0 _
    And Mid(sMontantMille, 4, 1) = 0 And Mid(sMontantMille, 5, 1) > 0 Then
    'Disaines (Left(sMontantMille, 1))
    'Unites (Mid(sMontantMille, 2, 1))
    sMontantMilleConversion = Left(sMontantMille, 2)
    sConversionMille = conversion(sMontantMilleConversion)
    ConversionMille = sConversionMille & " " & mille
    sMontantUnites = Right(sMontantMille, 1)
    sConversionFunction = conversion(sMontantUnites)
    ConversionMille = ConversionMille & " " & sConversionFunction
    ElseIf Left(sMontantMille, 1) > 1 And Mid(sMontantMille, 2, 1) > 0 And Mid(sMontantMille, 3, 1) = 0 _
    And Mid(sMontantMille, 4, 1) > 0 And Mid(sMontantMille, 5, 1) >= 0 Then
    'Disaines (Left(sMontantMille, 1))
    'Unites (Mid(sMontantMille, 2, 1))
    'ConversionMille = sConversionDisaines & " " & sConversionUnites & " " & mille
    sMontantMilleConversion = Left(sMontantMille, 2)
    sConversionMille = conversion(sMontantMilleConversion)
    ConversionMille = sConversionMille & " " & mille
    sMontantDisaines = Right(sMontantMille, 2)
    sConversionFunction = conversion(sMontantDisaines)
    ConversionMille = ConversionMille & " " & sConversionFunction
    ElseIf Left(sMontantMille, 1) > 1 And Mid(sMontantMille, 2, 1) > 0 And Mid(sMontantMille, 3, 1) > 0 _
    And Mid(sMontantMille, 4, 1) >= 0 And Mid(sMontantMille, 5, 1) >= 0 Then
    'Disaines (Left(sMontantMille, 1))
    ' Unites (Mid(sMontantMille, 2, 1))
    'ConversionMille = sConversionDisaines & " " & sConversionUnites & " " & mille
    sMontantMilleConversion = Left(sMontantMille, 2)
    sConversionMille = conversion(sMontantMilleConversion)
    ConversionMille = sConversionMille & " " & mille
    sMontantCentaines = Right(sMontantMille, 3)
    sConversionFunction = conversion(sMontantCentaines)
    ConversionMille = ConversionMille & " " & sConversionFunction

    End If

    End Select

    End Function

    Private Function ConversionCentMille(sMontantCentMille As String)
    Dim sConversionCentMille As String
    Dim iLengthCentMille As Integer
    iLengthCentMille = Len(sMontantCentMille)

    If iLengthCentMille = 6 And Mid(sMontantCentMille, 2, 1) > 0 Then
    If Left(sMontantCentMille, 1) = 1 Then
    Unites (Left(sMontantCentMille, 1))
    ConversionCentMille = cent
    sConversionCentMille = ConversionMille(Right(sMontantCentMille, 5))
    ConversionCentMille = ConversionCentMille & " " & sConversionCentMille
    Else
    Unites (Left(sMontantCentMille, 1))
    ConversionCentMille = sConversionUnites & " " & cent
    sConversionCentMille = ConversionMille(Right(sMontantCentMille, 5))
    ConversionCentMille = ConversionCentMille & " " & sConversionCentMille
    End If
    ElseIf iLengthCentMille = 6 And Mid(sMontantCentMille, 2, 1) = 0 And Left(sMontantCentMille, 1) = 1 Then

    Unites (Left(sMontantCentMille, 1))
    ConversionCentMille = cent
    sConversionCentMille = ConversionMille(Right(sMontantCentMille, 4))
    ConversionCentMille = ConversionCentMille & " " & sConversionCentMille
    ElseIf iLengthCentMille = 6 And Mid(sMontantCentMille, 2, 1) = 0 And Mid(sMontantCentMille, 3, 1) = 0 And _
    Mid(sMontantCentMille, 4, 1) = 0 And Mid(sMontantCentMille, 5, 1) = 0 And _
    Mid(sMontantCentMille, 6, 1) = 0 And Left(sMontantCentMille, 1) > 1 Then

    Unites (Left(sMontantCentMille, 1))
    ConversionCentMille = sConversionUnites & " " & cent & " " & mille

    ElseIf iLengthCentMille = 6 And Mid(sMontantCentMille, 2, 1) = 0 And Mid(sMontantCentMille, 3, 1) = 0 And _
    Mid(sMontantCentMille, 4, 1) = 0 And Mid(sMontantCentMille, 5, 1) = 0 And Left(sMontantCentMille, 1) > 1 Then

    Unites (Left(sMontantCentMille, 1))
    ConversionCentMille = sConversionUnites & " " & cent & " " & mille
    sConversionCentMille = conversion(Right(sMontantCentMille, 1))

    ConversionCentMille = ConversionCentMille & " " & sConversionCentMille

    ElseIf iLengthCentMille = 6 And Mid(sMontantCentMille, 2, 1) = 0 And Mid(sMontantCentMille, 3, 1) = 0 And _
    Mid(sMontantCentMille, 4, 1) = 0 And Left(sMontantCentMille, 1) > 1 Then

    Unites (Left(sMontantCentMille, 1))
    ConversionCentMille = sConversionUnites & " " & cent & " " & mille
    sConversionCentMille = conversion(Right(sMontantCentMille, 2))

    ConversionCentMille = ConversionCentMille & " " & sConversionCentMille
    ElseIf iLengthCentMille = 6 And Mid(sMontantCentMille, 2, 1) = 0 And Mid(sMontantCentMille, 3, 1) = 0 And _
    Left(sMontantCentMille, 1) > 1 Then

    Unites (Left(sMontantCentMille, 1))
    ConversionCentMille = sConversionUnites & " " & cent & " " & mille
    sConversionCentMille = conversion(Right(sMontantCentMille, 3))

    ConversionCentMille = ConversionCentMille & " " & sConversionCentMille

    ElseIf iLengthCentMille = 6 And Mid(sMontantCentMille, 2, 1) = 0 And Left(sMontantCentMille, 1) > 1 Then

    Unites (Left(sMontantCentMille, 1))
    ConversionCentMille = sConversionUnites & " " & cent
    sConversionCentMille = ConversionMille(Right(sMontantCentMille, 4))
    ConversionCentMille = ConversionCentMille & " " & sConversionCentMille

    End If

    End Function

    Public Function ConversionDecimale(sMontantDecimale As String)
    Dim sMontantEntier As String, sVirgule As String, sDecimale As String
    Dim iLengthMontantEntier As Integer, iLengthDecimale As Integer

    sMontantEntier = Left(sMontantDecimale, InStr(1, sMontantDecimale, ",", vbTextCompare) - 1)
    'sVirgule = Mid(sMontantDecimale, Len(sMontantDecimale) - 3, 1)
    sDecimale = Right(sMontantDecimale, Len(sMontantDecimale) - InStr(1, sMontantDecimale, ",", vbTextCompare))

    iLengthMontantEntier = Len(sMontantEntier)
    iLengthDecimale = Len(sDecimale)

    If iLengthDecimale = 1 Then

    Disaines (sDecimale)
    'ConversionDecimale = sConversionDisaines
    Select Case iLengthMontantEntier

    Case Is = 1
    If sMontantEntier = 0 Then

    ConversionDecimale = sConversionDisaines & " " & centimes
    ElseIf sMontantEntier > 0 Then
    ConversionDecimale = conversion(sMontantEntier) & " " & euros & " et " & _
    sConversionDisaines & " " & centimes

    End If
    Case Is = 2

    ConversionDecimale = conversion(sMontantEntier) & " " & _
    euros & " et "
    Disaines (sDecimale)
    ConversionDecimale = ConversionDecimale & sConversionDisaines & " " & centimes

    Case Is = 3
    ConversionDecimale = conversion(sMontantEntier) & " " & euros & " et "
    Disaines (sDecimale)
    ConversionDecimale = ConversionDecimale & sConversionDisaines & " " & centimes
    Case Is = 4
    ConversionDecimale = ConversionMille(sMontantEntier) & " " & euros & " et "
    Disaines (sDecimale)
    ConversionDecimale = ConversionDecimale & sConversionDisaines & " " & centimes
    Case Is = 5
    ConversionDecimale = ConversionMille(sMontantEntier) & " " & euros & " et "
    Disaines (sDecimale)
    ConversionDecimale = ConversionDecimale & sConversionDisaines & " " & centimes

    Case Is = 6
    ConversionDecimale = ConversionCentMille(sMontantEntier) & " " & euros & " et "
    Disaines (sDecimale)
    ConversionDecimale = ConversionDecimale & sConversionDisaines & " " & centimes

    End Select

    ElseIf iLengthDecimale = 2 Then

    Select Case iLengthMontantEntier

    Case Is = 1
    If sMontantEntier = 0 Then
    If Left(sDecimale, 1) = 0 Then
    Unites (Right(sDecimale, 1))
    ConversionDecimale = sConversionUnites & " " & centimes
    Else
    ConversionDecimale = conversion(sDecimale) & " " & centimes
    End If
    ElseIf sMontantEntier > 0 And Left(sDecimale, 1) = 0 Then

    Unites (Right(sDecimale, 1))
    ConversionDecimale = conversion(sMontantEntier) & " " & euros & " et " & _
    conversion(Right(sDecimale, 1)) & " " & centimes
    ElseIf sMontantEntier > 0 Then
    ConversionDecimale = conversion(sMontantEntier) & " " & euros & " et " & _
    conversion(sDecimale) & " " & centimes

    End If
    Case Is = 2
    If Left(sDecimale, 1) = 0 Then
    ConversionDecimale = conversion(sMontantEntier) & " " & _
    euros & " et " & conversion(Right(sDecimale, 1)) & " " & centimes
    Else

    ConversionDecimale = conversion(sMontantEntier) & " " & _
    euros & " et " & conversion(sDecimale) & " " & centimes
    End If
    Case Is = 3
    'ConversionDecimale = conversion(sMontantEntier) & " " & euros & " et " & _
    'conversion(sDecimale) & " " & centimes
    If Left(sDecimale, 1) = 0 Then
    ConversionDecimale = conversion(sMontantEntier) & " " & _
    euros & " et " & conversion(Right(sDecimale, 1)) & " " & centimes
    Else

    ConversionDecimale = conversion(sMontantEntier) & " " & _
    euros & " et " & conversion(sDecimale) & " " & centimes
    End If
    Case Is = 4
    'ConversionDecimale = ConversionMille(sMontantEntier) & " " & euros & " et " & _
    'conversion(sDecimale) & " " & centimes
    If Left(sDecimale, 1) = 0 Then
    ConversionDecimale = ConversionMille(sMontantEntier) & " " & _
    euros & " et " & conversion(Right(sDecimale, 1)) & " " & centimes
    Else

    ConversionDecimale = ConversionMille(sMontantEntier) & " " & _
    euros & " et " & conversion(sDecimale) & " " & centimes
    End If
    Case Is = 5
    'ConversionDecimale = ConversionMille(sMontantEntier) & " " & euros & " et " & _
    'conversion(sDecimale) & " " & centimes
    If Left(sDecimale, 1) = 0 Then
    ConversionDecimale = ConversionMille(sMontantEntier) & " " & _
    euros & " et " & conversion(Right(sDecimale, 1)) & " " & centimes
    Else

    ConversionDecimale = ConversionMille(sMontantEntier) & " " & _
    euros & " et " & conversion(sDecimale) & " " & centimes
    End If
    Case Is = 6
    'ConversionDecimale = ConversionCentMille(sMontantEntier) & " " & euros & " et " & _
    'conversion(sDecimale) & " " & centimes
    If Left(sDecimale, 1) = 0 Then
    ConversionDecimale = ConversionCentMille(sMontantEntier) & " " & _
    euros & " et " & conversion(Right(sDecimale, 1)) & " " & centimes
    Else

    ConversionDecimale = ConversionCentMille(sMontantEntier) & " " & _
    euros & " et " & conversion(sDecimale) & " " & centimes
    End If
    End Select

    End If
    End Function
    Public Function ConversionNormale(sMontantNormal As String)

    Dim iLengthMontantNormal As Integer
    iLengthMontantNormal = Len(sMontantNormal)

    Select Case iLengthMontantNormal
    Case Is = 0
    ConversionNormale = ""

    Case 1 To 3
    ConversionNormale = conversion(sMontantNormal) & " " & euros

    Case Is <= 5
    ConversionNormale = ConversionMille(sMontantNormal) & " " & euros

    Case Is = 6
    ConversionNormale = ConversionCentMille(sMontantNormal) & " " & euros
    End Select

    End Function

    ==============================================================

    A+
    1
  2. Armojax Messages postés 1863 Date d'inscription   Statut Membre Dernière intervention   1 529
     
    Bonjour,

    Je propose également la fonction ci-dessous :
    Elle admet deux paramètres supplémentaires :
    - choix de la monnaie (euro par défaut)
    - résultat en majuscules ou minuscules (majuscules par défaut)

    Si A1 contient 23.56,
    CHIFLETR(A1) : VINGT-TROIS EUROS ET CINQUANTE-SIX CENTIMES
    CHIFLETR(A1;"dollar") : VINGT-TROIS DOLLARS ET CINQUANTE-SIX CENTIMES
    CHIFLETR(A1;;FAUX) : vingt-trois euros et cinquante-six centimes

    Voici le code :
    Function CHIFLETR(Nombre, Optional Monnaie As String = "euro", Optional Maju As Boolean = True)
    
        ' CETTE FONCTION TRADUIT EN LETTRES UN NOMBRE POSITIF INFERIEUR
        ' AU MILLIARD, AVEC DEUX DECIMALES
        
        ' Elle fait appel à la macro "Codage" ci-dessous,
        ' qui en est indissociable
    
        Dim TrCent      As Boolean
        Dim CenTouRon   As Boolean
        
        Dim Entiers     As Long
        Dim Centimes    As Long
        
        Dim TrUnités    As Integer
        Dim TrMilles    As Integer
        Dim TrMlions    As Integer
        
        Dim QuUnités    As Long
        Dim QuMilles    As Long
        Dim QuMlions    As Long
        
        Dim Lib         As String
        
        If Nombre > 999999999.99 Then
            CHIFLETR = ""
            Exit Function
        End If
        
        Entiers = Int(Nombre)
        Centimes = (Nombre - Entiers) * 100
        TrUnités = Entiers Mod 1000
        QuUnités = Entiers \ 1000
        TrMilles = QuUnités Mod 1000
        QuMilles = QuUnités \ 1000
        TrMlions = QuMilles Mod 1000
        QuMlions = QuMilles \ 1000
        
        Lib = ""
        
        CenTouRon = (Entiers Mod 100) = 0
        
        If TrMlions <> 0 Then
            Call Codage(TrMlions, Lib, CenTouRon, False)
            If TrMlions = 1 Then
                Lib = Lib & "million "
            Else
                Lib = Lib & "millions "
            End If
        End If
        
        If TrMilles <> 0 Then
            If TrMilles <> 1 Then
                Call Codage(TrMilles, Lib, CenTouRon, False)
            End If
            Lib = Lib & "mille "
        End If
        
        If TrUnités <> 0 Then
            Call Codage(TrUnités, Lib, CenTouRon, True)
        End If
        
        If Entiers >= 2 Then
            Lib = Lib & Monnaie & "s "
        ElseIf Entiers >= 1 Then
            Lib = Lib & Monnaie & " "
        Else
            Lib = "zéro " & Monnaie & " "
        End If
        If Centimes <> 0 Then
            Lib = Lib & "et "
            Call Codage(Centimes, Lib, CenTouRon, False)
            If Centimes = 1 Then
                Lib = Lib & "centime "
            Else
                Lib = Lib & "centimes "
            End If
        End If
    
        CHIFLETR = Lib
        
        If Maju Then CHIFLETR = UCase(CHIFLETR)
    
    End Function
    Sub Codage(Tranche, Lib, CenTouRon, TrCent)
    
        ' CETTE MACRO EST INDISSOCIABLE DE LA FONCTION CHIFLETR
        ' CI-DESSUS, ET TRADUIT EN LETTRES UNE TRANCHE DE 3 CHIFFRES
    
        Dim C       As Byte, D As Byte, D1 As Byte, U As Byte
        Dim T00     As Variant
        Dim Tb0     As Variant, Tb1 As Variant, Tb2 As Variant, Tb3 As Variant, Tb4 As Variant
        Dim Tb5     As Variant, Tb6 As Variant, Tb7 As Variant, Tb8 As Variant, Tb9 As Variant
        
        T00 = Array("", "", "deux ", "trois ", "quatre ", "cinq ", "six ", "sept ", "huit ", "neuf ")
        
        Tb0 = Array("", "un ", "deux ", "trois ", "quatre ", "cinq ", "six ", "sept ", "huit ", "neuf ")
        Tb1 = Array("dix ", "onze ", "douze ", "treize ", "quatorze ", "quinze ", "seize ", "dix-sept ", "dix-huit ", "dix-neuf ")
        Tb2 = Array("vingt ", "vingt-et-un ", "vingt-deux ", "vingt-trois ", "vingt-quatre ", "vingt-cinq ", "vingt-six ", "vingt-sept ", "vingt-huit ", "vingt-neuf ")
        Tb3 = Array("trente ", "trente-et-un ", "trente-deux ", "trente-trois ", "trente-quatre ", "trente-cinq ", "trente-six ", "trente-sept ", "trente-huit ", "trente-neuf ")
        Tb4 = Array("quarante ", "quarante-et-un ", "quarante-deux ", "quarante-trois ", "quarante-quatre ", "quarante-cinq ", "quarante-six ", "quarante-sept ", "quarante-huit ", "quarante-neuf ")
        Tb5 = Array("cinquante ", "cinquante-et-un ", "cinquante-deux ", "cinquante-trois ", "cinquante-quatre ", "cinquante-cinq ", "cinquante-six ", "cinquante-sept ", "cinquante-huit ", "cinquante-neuf ")
        Tb6 = Array("soixante ", "soixante-et-un ", "soixante-deux ", "soixante-trois ", "soixante-quatre ", "soixante-cinq ", "soixante-six ", "soixante-sept ", "soixante-huit ", "soixante-neuf ")
        Tb7 = Array("soixante-dix ", "soixante-et-onze ", "soixante-douze ", "soixante-treize ", "soixante-quatorze ", "soixante-quinze ", "soixante-seize ", "soixante-dix-sept ", "soixante-dix-huit ", "soixante-dix-neuf ")
        Tb8 = Array("quatre-vingt ", "quatre-vingt-un ", "quatre-vingt-deux ", "quatre-vingt-trois ", "quatre-vingt-quatre ", "quatre-vingt-cinq ", "quatre-vingt-six ", "quatre-vingt-sept ", "quatre-vingt-huit ", "quatre-vingt-neuf ")
        Tb9 = Array("quatre-vingt-dix ", "quatre-vingt-onze ", "quatre-vingt-douze ", "quatre-vingt-treize ", "quatre-vingt-quatorze ", "quatre-vingt-quinze ", "quatre-vingt-seize ", "quatre-vingt-dix-sept ", "quatre-vingt-dix-huit ", "quatre-vingt-dix-neuf ")
        
        C = Tranche \ 100
        If C <> 0 Then
            If TrCent And CenTouRon And C <> 1 Then
                Lib = Lib & T00(C) & "cents "
            Else
                Lib = Lib & T00(C) & "cent "
            End If
        End If
        D1 = Tranche Mod 100
        D = D1 \ 10
        U = Tranche Mod 10
        
        Select Case D
            Case 0: Lib = Lib & Tb0(U)
            Case 1: Lib = Lib & Tb1(U)
            Case 2: Lib = Lib & Tb2(U)
            Case 3: Lib = Lib & Tb3(U)
            Case 4: Lib = Lib & Tb4(U)
            Case 5: Lib = Lib & Tb5(U)
            Case 6: Lib = Lib & Tb6(U)
            Case 7: Lib = Lib & Tb7(U)
            Case 8: Lib = Lib & Tb8(U)
            Case 9: Lib = Lib & Tb9(U)
        End Select
    
    End Sub
    1
    1. KAYOUH
       
      merci beaucoup pour votre réponse, et vous souhaite bonne santé et heureuse vie
      0
    2. accuspeaker
       
      j'ai recherche depuis beaucoup semaines cette solution... merci pour votre code (c'est le plus elegant que j'ai vu)
      excuse moi pur le francais, j'suis seulemnet un mec chilien
      a +
      0
    3. ZAZIE
       
      Merci pour les codes mais le problème se présente au niveau d'utilisation du code sous access2003. je n'arrive pas a placer le code pour l'utiliser dans un états sous forme de facture. j'aimerai bien savoir ou mettre ce code pour qu'il fonctionne correctement dans la facture.
      Merci d'avance!!
      0