[vba basic]法语名称转换V2

Posted 2021-02-22

convert numbers to letters (french) V2

Public Function ConvNumToAlpha(ByVal Nombre As Double, ByVal Def_EUR__ID1_CHF__ID2_CAD As Double) As String
        ' MAJ: http://www.vbfrance.com/codes/TRADUIRE-GROS-CHIFFRES-LETTRES-AVEC-CORRECTION-ORTOGRAPHIQUE_47934.aspx
        ' Supporte plusieures devises ainsi que des nombres jusqu'aux quadrillions
        ' Tout est dans cette fonction, il n'est pas nécessaire de faire des déclarations au niveau du module
        Dim sFormat As String, sTraducteur As String, Chiffre As Integer, ChiffreMem As Integer
        Dim I As Integer, X As Integer, sAtome As String, S As String, Group As Integer, GroupMem As Integer
        Static CENTAINNES, DIZAINNES, UNITES, DIVERS, PARTICULIER
        Static devise, CouranteDevise As Integer, Updated As Boolean
        '
        If CouranteDevise <> Def_EUR__ID1_CHF__ID2_CAD Then
            Updated = False 'changement de divise, on doit alors re-initialiser les variables statiques
            CouranteDevise = Def_EUR__ID1_CHF__ID2_CAD
        End If
        If Not Updated Then 'afin d'économiser le CPU, les tableaux suivants sont mis à jour seulement quand nécessaire
            Updated = True
            'DEVISE = Split(" Euro, Franc, Dollar", ",")
            UNITES = Split(", un, deux, trois, quatre, cinq, six, sept, huit, neuf, dix, onze, douze, treize, quatorze, quinze, seize, dix-sept, dix-huit, dix-neuf", ",")
            DIZAINNES = Split(", dix, vingt, trente, quarante, cinquante, soixante, soixante-dix, quatre-vingt, quatre-vingt-dix", ",")
            CENTAINNES = Split(", cent, deux cent, trois cent, quatre cent, cinq cent, six cent, sept cent, huit cent, neuf cent", ",")
            PARTICULIER = Split(Chr(71) & Chr(80) & Chr(81) & ", soixante et onze, quatre-vingts, quatre-vingt-un", ",")
            'DIVERS = Split("MmiBbTQ., mille, million, milliard, billion, billiard, trillion, quadrillion, Euro ", ",")
            DIVERS = Split("MmiBbTQ., mille, million, milliard, billion, billiard, trillion, quadrillion,", ",")
 
            If CouranteDevise Then  'Francs suisses, Dollars canadians
                DIZAINNES(7) " septante" : DIZAINNES(8) " huitante" : DIZAINNES(9) = " nonante"
                ReDim PARTICULIER(0)
            End If
        End If
        On Error GoTo Fin
        '-------------------------------------CDUQCDUTCDUbCDUBCDUiCDUmCDUMCDU.DU-----------------------------
        sFormat = Trim(Format$(CDec(Nombre), "### ### ### ### ### ### ### ###.00")) ' Traduire notre nombre au format
        sTraducteur = Right$("CDUQCDUTCDUbCDUBCDUiCDUmCDUMCDU.DU", Len(sFormat))    ' compatible avec 'sTraducteur'
        'Text3 = sFormat
        If Int(Nombre) 0 Then S "Zéro"
        Group = 2
        X = InStr(sFormat, " ")
        If X Then Group = Val(Mid(sFormat, 1, X))
        For I = 1 To Len(sFormat)
            Chiffre = Val(Mid$(sFormat, I, 1))
            sAtome = Mid$(sTraducteur, I, 1)
            Select Case sAtome
                Case "U" ' les unités
                    If Group 1 And Mid(sTraducteur, I + 1, 1) "M" Then ' éviter les 'Un mille'
                    ElseIf Chiffre = 1 And ChiffreMem > 0 Then ' vingt et un, trente et un
                        S = S & " et" & UNITES(Chiffre)
                    ElseIf Chiffre > 1 And ChiffreMem > 0 Then ' vingt-deux, trente-trois
                        S = S & "-" & LTrim(UNITES(Chiffre))
                    ElseIf Chiffre Then
                        If Mid(sFormat, I + 1, 1) "." And GroupMem 0 And Nombre > 1000 Then S = S & " et"
                        S = S & UNITES(Chiffre)
                    End If
                Case "D" ' les dizainnes
                    X = InStr(PARTICULIER(0), Chr(Val(Mid$(sFormat, I, 2))))
                    If X Then 'soixante et onze, quatre-vingts, quatre-vingt-un
                        S = S & PARTICULIER(X)
                        I = I + 1 'éviter les prochainnes unités
                    ElseIf CouranteDevise = 0 And InStr("79", CStr(Chiffre)) > 0 And Val(Mid$(sFormat, I + 1, 1)) > 0 Then
                        S = S & DIZAINNES(Chiffre - 1)
                        I = I + 1 'éviter les prochainnes unités
                        ChiffreMem = Chiffre
                        Chiffre = Val(Mid$(sFormat, I, 1))
                        If ChiffreMem = 1 Then ' onze, douze
                            S = S & UNITES(Chiffre + 10)
                        Else ' soixante-onze, quatre-vingt-douze
                            S = S & "-" & LTrim(UNITES(Chiffre + 10))
                        End If
                    ElseIf Chiffre = 1 Then
                        S = S & UNITES(Val(Mid$(sFormat, I + 1, 1) + 10))
                        I = I + 1
                    ElseIf Chiffre Then
                        S = S & DIZAINNES(Chiffre)
                    End If
                Case "C" ' les centainnes
                    GroupMem = Group
                    Group = Val(Mid(sFormat, I, 3))
                    If Chiffre Then
                        S = S & CENTAINNES(Chiffre)
                        If Mid$(sFormat, I + 1, 3) = "00." And Chiffre > 1 Then
                            S S & "s" 'pluriel sur les centainnes: 600 six cents, 601= six cent un
                        End If
                    End If
                Case Else
                    X = InStr(DIVERS(0), sAtome)
                    If X > 0 And Group > 0 Then
                        S = S & DIVERS(X)
                        If Group > 1 And InStr("miBbTQ", sAtome) > 0 Then
                            S = S & "s" ' traiter les pluriels de million, milliard et billion
                        End If
                    ElseIf sAtome = "." Then
                        S = S & DIVERS(X)
                    End If
            End Select
            ChiffreMem = Chiffre ' mémoriser ce dernier chiffre
        Next
        ConvNumToAlpha = UCase(Mid(S, 1, 1)) & Mid(S, 2) ' mettre première lettre en majuscules
        Exit Function
Fin:
        If Len(Trim(Nombre)) Then MsgBox(Err.Description, vbCritical + vbSystemModal)
    End Function