[vba basic]法语名称转换V1

Posted 2021-02-22

convert numbers to text (french) V1

' *****************************************************************************
' ConvertitLettres
' *****************************************************************************
Public Function ConvertitLettres(Nombre,ChMonnaie)
    Dim NomUnites
    Dim valeurs
    Dim chaine
    dim sVar
    'tableau((billion,milliard,million,millier,unité,décimale),(centaine,dizaine,unité))
    Dim strT ' lettres de chaque chiffre selon emplacement
    Dim intD ' indicateur si chiffre avant, règle grammaticale (DEUX CENTS, DEUX CENT CINQ)
    Dim intT ' chiffre selon emplacement
    Dim b ' pour les boucle de traitement
    Dim d ' indicateur de décimale
    Dim Dizaine
    Dim ln
    Dim Presence
    Dim LeTiret
    Dim LaRetenue
    Dim Resultat
    ReDim NomUnites(90)
    ReDim valeurs(5)
    ReDim chaine(5)
    'tableau((billion,milliard,million,millier,unité,décimale),(centaine,dizaine,unité))
    ReDim strT(5, 2) ' lettres de chaque chiffre selon emplacement
    ReDim intD(5, 2) ' indicateur si chiffre avant, règle grammaticale (DEUX CENTS, DEUX CENT CINQ)
    ReDim intT(5, 2)  ' chiffre selon emplacement
    ReDim Presence(5)
 
 
    ' Initialisation de valeurs
    valeurs(5) = " billion"
    valeurs(4) = " milliard"
    valeurs(3) = " million"
    valeurs(2) = " mille"
    valeurs(1) = "" ' unité
    valeurs(0) = "" ' décimale
 
 
    ' Initialisation des termes de NomUnites
    NomUnites(0) = "zéro"
    NomUnites(1) = "un"
    NomUnites(2) = "deux"
    NomUnites(3) = "trois"
    NomUnites(4) = "quatre"
    NomUnites(5) = "cinq"
    NomUnites(6) = "six"
    NomUnites(7) = "sept"
    NomUnites(8) = "huit"
    NomUnites(9) = "neuf"
 
 
    ' Initialisation des termes de la dizaine
    NomUnites(10) = "dix"
    NomUnites(11) = "onze"
    NomUnites(12) = "douze"
    NomUnites(13) = "treize"
    NomUnites(14) = "quatorze"
    NomUnites(15) = "quinze"
    NomUnites(16) = "seize"
    NomUnites(17) = "dix-sept"
    NomUnites(18) = "dix-huit"
    NomUnites(19) = "dix-neuf"
 
 
    ' Initialisation des termes de dizaines
    NomUnites(20) = "vingt"
    NomUnites(30) = "trente"
    NomUnites(40) = "quarante"
    NomUnites(50) = "cinquante"
    NomUnites(60) = "soixante"
    NomUnites(70) = "soixante"
    NomUnites(80) = "quatre-vingt"
    NomUnites(90) = "quatre-vingt"
 
 
    ' Classification du nombre en sous-unités
    d = InStr(1, Nombre, ",") ' nombre entier ou avec décimale
    If d Then
        Nombre = Left(Nombre, d - 1) + "0" + Mid(Nombre, d + 1) ' remplace la virgule par zéro        If Len(Nombre) - d 1 Then Nombre Nombre + "0" 's'assure qu'il y a 2 décimales
        If Len(Nombre) - d > 2 Then ' sinon on arrondit à 2 décimales
            If Mid(Nombre, d + 3, 1) >= 5 Then
                Nombre = Mid(Nombre, 1, d + 1) & (1 + Mid(Nombre, d + 2, 1))
                Nombre = Mid(Nombre, 1, d + 2)
            Else
                Nombre = Mid(Nombre, 1, d + 2)
            End If
        End If
    Else
        Nombre = Nombre + "000" 'sinon on ajoute pour combler les décimales
    End If
    intD(0, 0) = 0
    ln = Len(Nombre)
    For b = 0 To ln - 1
        intT(b  3, b Mod 3) = Mid(Nombre, ln - b, 1)
        If intT(b  3, b Mod 3) <> 0 then
           sVar = b + 1
        else
           sVar = intD(b  3, b Mod 3)
        end if
        If (b <> ln - 1) And b > 3 Then intD((b + 1)  3, (b + 1) Mod 3) = sVar
    Next
    ' Recherche des termes adaptés à chaque sous-unité
    For b = (ln  3 + ln Mod 3) - 1 To 0 Step -1
        strT(b, 0) = ""
        chaine(b) = ""
        LeTiret = False
        LaRetenue = 0
        If intT(b, 2) * 100 + intT(b, 1) * 10 + intT(b, 0) <> 0 Then
            ' Activation du drapeau
            Presence(b) = intT(b, 2) * 100 + intT(b, 1) * 10 + intT(b, 0)
            ' Nombre supérieur ou égal à 1
            ' Vérification si supérieur ou égale à 100
            If intT(b, 2) >= 2 Then
               if intD(b, 2) <> 0 Then
                  sVar = ""
               else
                  sVar = "s"
               end if
                strT(b, 2) = NomUnites(intT(b, 2)) + " cent" + sVar
            ElseIf intT(b, 2) = 1 Then
                strT(b, 2) = "cent"
            End If
            Dizaine = intT(b, 1) * 10 + intT(b, 0)
            ' Vérification si supérieur à 20
            If Dizaine >= 20 Then               if intT(b, 1) 8 And intD(b, 1) 0 then
                  sVar = "s"
               else
                  sVar = ""
               end if
                strT(b, 1) = NomUnites(intT(b, 1) * 10) + sVar
                If Dizaine >= 60 Then
                    LaRetenue = ((Dizaine  10) - 6) Mod 2
                End If
                LeTiret = True
            ElseIf Dizaine >= 10 And Dizaine <= 19 Then
                strT(b, 1) = strT(b, 1) + " " + NomUnites(Dizaine)
            End If
            ' Vérification si unité non-nul
            If (intT(b, 0) > 0 And intT(b, 1) <> 1) Or LaRetenue Then 'Dizaine <> 1 Then
                If LeTiret And intT(b, 1) <> 1 Then
                    If intT(b, 0) = 1 And intT(b, 1) < 8 Then
                        strT(b, 0) = " et " + NomUnites(intT(b, 0) + LaRetenue * 10)
                    Else
                        strT(b, 0) = "-" + NomUnites(intT(b, 0) + LaRetenue * 10)
                    End If
                ElseIf b <> 2 Then
                    strT(b, 0) = NomUnites(intT(b, 0) + LaRetenue * 10)
                    ElseIf intT(b, 0) <> 1 Then strT(b, 0) = " " + NomUnites(intT(b, 0) + LaRetenue * 10)
                End If
            End If
            ' concatenation des centaines, dizaines et unités et retrait des espaces inutiles
            if strT(b, 1) = "" then
               sVar = ""
            else
               sVar = " "
            end if
            chaine(b) = Trim(Trim(strT(b, 2)) + sVar + Trim(strT(b, 1)))
            if Left(strT(b, 0), 1) = "-" then
               sVar = ""
            else
               sVar = " "
            end if
            chaine(b) = trim(chaine(b) + sVar + Trim(strT(b, 0)))
'            + IIf(Left(strT(b, 0), 1) = "-", "", " ") +
            ' ajout de la valeurs si > 1 et différent des Mille (invariable)
            if (Presence(b) > 1) And (b > 2) then 'IIf((Presence(b) > 1) And (b > 2), "s", "")
                sVar = "s"
            else
                sVar =""
            end if
            chaine(b) = chaine(b) + valeurs(b) + sVar
        End If
    Next
 
 
    ' concatenation finale et retrait des espaces inutiles
    Resultat = chaine(5)
    For b = 4 To 1 Step -1
        if chaine(b) <> "" then 'IIf(chaine(b) <> "", " ", "")
           sVar = " "
        else
           sVar = ""
        end if
        Resultat = Resultat + sVar + chaine(b)
    Next    If Resultat "" Then Resultat "zéro"
    if INSTR(1,Nombre,",")>0 then
        if Mid(Nombre, INSTR(1,Nombre,",")+1)*1 > 1 then 'IIf(CDec(Mid(Nombre, 1, Len(Nombre) - 3)) > 1, "s", "")
           sVar = "s"
        else
           sVar = ""
        end if
    else
        sVar = ""
    end if    If ChMonnaie True Then Resultat Resultat + " Euro" + sVar
    If chaine(0) <> "" Then
        Resultat = Resultat + " et " + chaine(0)
        if Presence(0) > 1 Then 'IIf(Presence(0) > 1, "s", "")
           sVar = "s"
        else
           sVar = ""
        end if        If ChMonnaie True Then Resultat Resultat + " centime" + sVar
    End If
    ' Fin
    ConvertitLettres = Trim(UCase(Resultat))
End Function