Supprimer la virgule et changer de devise dans la macro Nblettre

Bonjour le forum,
J'ai besoin de votre aide pour modifier la macro Nblettre. En effet, lorsque j'ai un chiffre comme "205 300, 4"; la formule convnumberletter donne "deux cent cinq mille trois cents virgule quarante".

Le problème est que je suis en Afrique centrale, la monnaie utilisée est le Francs CFA. contrairement à l'euro, Il n'existe pas de centime chez nous. les décimaux sont arrondis à l'unité près. Je veux donc modifier la macro de telle sorte que les chiffres décimaux soit directement arrondis à l'unité près et que la formule ne mentionne plus le mot "virgule". Et au passage que la première lettre soit en majuscule.

Merci d'avance

32leby.xlsm (23.11 Ko)

Bonjour,

Il s'agit d'une procédure ou d'une fonction ?

Parce que le plus simple serait d'arrondir le nombre avant qu'il rentre en argument de la fonction (si c'en est une).

=convnumberletter(arrondi(A1;0))

Cdlt,

Bonjour, pour compléter la solution de 3BG Première majuscule et devise monétaire :

=CONCATENER(MAJUSCULE(STXT(ConvNumberLetter(ARRONDI(A2;0));1;1));STXT(ConvNumberLetter(ARRONDI(A2;0));2;2000))&" FCFA"

-----> Deux cent cinq mille trois cents FCFA

20leby.xlsm (22.91 Ko)

Bonjour 3GB et Xmenpel,

Merci pour vos interventions qui me dépannent vraiment!
@3GB, je suis novice dans sur excel, donc je ne peux connaitre si c'est une procedure ou fonction

Pour la Majuscule, il y a-t-il une possibilité d'intégrer un code dans la macro?

Bonjour Leby, Salut Xmenpl,

Pour faire simple, une procédure exécute des actions tandis qu'une fonction renvoie un résultat (en fonction de paramètres le plus souvent).

function a() '<<< fonction
end function

sub b() '<<< procédure
end sub

D'après la réponse d'Xmenpl, je vois qu'il s'agit bien d'une fonction. Peux-tu poster le code ici à l'aide des balises </> du ruban d'icônes ?

Cdlt,

Bonjour à toutes et tous, Leby, 3GB, Xmenpl,

@Leby,

A tester dans le fichier joint:

Chaque début de lettre en Majuscule et CFA en MAJUSCULE sans "s" à la fin.

@3GB,

Voici le code de la fonction modifiée:

Option Explicit

'------------------------------------------------------------------------------------
' Devise=0   aucune
'       =1   Euro ?
'       =2   CFA
'------------------------------------------------------------------------------------
'
'   Conversion limitée à 999 999 999 999 999 ou 9 999 999 999 999,99
'   si le nombre contient plus de 2 décimales, il est arrondit à 2 décimales
'
'------------------------------------------------------------------------------------

Public Function ConvNumberLetter(Nombre As Double, Optional Devise As Byte = 0, Optional Langue As Byte = 0) As String
Dim dblEnt As Variant, byDec As Byte
Dim bNegatif As Boolean
Dim strDev As String, strCentimes As String

    If Nombre < 0 Then
        bNegatif = True
        Nombre = Abs(Nombre)
    End If
    dblEnt = Int(Nombre)
    byDec = CInt((Nombre - dblEnt) * 100)
    If byDec = 0 Then
        If dblEnt > 999999999999999# Then
            ConvNumberLetter = "#TropGrand"
            Exit Function
        End If
    Else
        If dblEnt > 9999999999999.99 Then
            ConvNumberLetter = "#TropGrand"
            Exit Function
        End If
    End If
    Select Case Devise
        Case 0
            If byDec > 0 Then strDev = " virgule "
        Case 1
            strDev = " Euro"
            If dblEnt >= 1000000 And Right$(dblEnt, 6) = "000000" Then strDev = " d'Euro"
            If byDec > 0 Then strCentimes = strCentimes & " Centime"
            If byDec > 1 Then strCentimes = strCentimes & "s"
        Case 2
            strDev = " CFA"
            If byDec > 0 Then strCentimes = strCentimes & " Cent"
    End Select
    'If dblEnt > 1 And Devise <> 0 Then strDev = strDev & "s"
    'strDev = strDev & " "
    If dblEnt = 0 Then
        ConvNumberLetter = "" & strDev
    Else
        ConvNumberLetter = Application.WorksheetFunction.Proper(ConvNumEnt(CDbl(dblEnt), Langue)) & strDev
    End If
    If byDec = 0 Then
        'If Devise <> 0 Then ConvNumberLetter = ConvNumberLetter & "zéro Cent"
    Else
        If Devise = 0 Then
            ConvNumberLetter = ConvNumberLetter & _
                               ConvNumDizaine(byDec, Langue, True) & strCentimes
        Else
            ConvNumberLetter = ConvNumberLetter & _
                               ConvNumDizaine(byDec, Langue, False) & strCentimes
        End If
    End If
    ConvNumberLetter = Replace(ConvNumberLetter, "  ", " ")
    If Left(ConvNumberLetter, 1) = " " Then ConvNumberLetter = _
       Right$(ConvNumberLetter, Len(ConvNumberLetter) - 1)
    If Right$(ConvNumberLetter, 1) = " " Then ConvNumberLetter = _
       Left(ConvNumberLetter, Len(ConvNumberLetter) - 1)
End Function

Private Function ConvNumEnt(Nombre As Double, Langue As Byte)
Dim iTmp As Variant, dblReste As Double
Dim strTmp As String
Dim iCent As Integer, iMille As Integer, iMillion As Integer
Dim iMilliard As Integer, iBillion As Integer

    iTmp = Nombre - (Int(Nombre / 1000) * 1000)
    iCent = CInt(iTmp)
    ConvNumEnt = Nz(ConvNumCent(iCent, Langue))
    dblReste = Int(Nombre / 1000)
    If iTmp = 0 And dblReste = 0 Then Exit Function
    iTmp = dblReste - (Int(dblReste / 1000) * 1000)
    If iTmp = 0 And dblReste = 0 Then Exit Function
    iMille = CInt(iTmp)
    strTmp = ConvNumCent(iMille, Langue)
    Select Case iTmp
        Case 0
        Case 1
            strTmp = " mille "
        Case Else
            strTmp = strTmp & " mille "
    End Select
    If iMille = 0 And iCent > 0 Then ConvNumEnt = "et " & ConvNumEnt
    ConvNumEnt = Nz(strTmp) & ConvNumEnt
    dblReste = Int(dblReste / 1000)
    iTmp = dblReste - (Int(dblReste / 1000) * 1000)
    If iTmp = 0 And dblReste = 0 Then Exit Function
    iMillion = CInt(iTmp)
    strTmp = ConvNumCent(iMillion, Langue)
    Select Case iTmp
        Case 0
        Case 1
            strTmp = strTmp & " million "
        Case Else
            strTmp = strTmp & " millions "
    End Select
    If iMille = 1 Then ConvNumEnt = "et " & ConvNumEnt
    ConvNumEnt = Nz(strTmp) & ConvNumEnt
    dblReste = Int(dblReste / 1000)
    iTmp = dblReste - (Int(dblReste / 1000) * 1000)
    If iTmp = 0 And dblReste = 0 Then Exit Function
    iMilliard = CInt(iTmp)
    strTmp = ConvNumCent(iMilliard, Langue)
    Select Case iTmp
        Case 0
        Case 1
            strTmp = strTmp & " milliard "
        Case Else
            strTmp = strTmp & " milliards "
    End Select
    If iMillion = 1 Then ConvNumEnt = "et " & ConvNumEnt
    ConvNumEnt = Nz(strTmp) & ConvNumEnt
    dblReste = Int(dblReste / 1000)
    iTmp = dblReste - (Int(dblReste / 1000) * 1000)
    If iTmp = 0 And dblReste = 0 Then Exit Function
    iBillion = CInt(iTmp)
    strTmp = ConvNumCent(iBillion, Langue)
    Select Case iTmp
        Case 0
        Case 1
            strTmp = strTmp & " billion "
        Case Else
            strTmp = strTmp & " billions "
    End Select
    If iMilliard = 1 Then ConvNumEnt = "et " & ConvNumEnt
    ConvNumEnt = Nz(strTmp) & ConvNumEnt
End Function

Private Function ConvNumDizaine(Nombre As Byte, Langue As Byte, bDec As Boolean) As String
Dim TabUnit As Variant, TabDiz As Variant
Dim byUnit As Byte, byDiz As Byte
Dim strLiaison As String

    If bDec Then
        TabDiz = Array("zéro", "", "vingt", "trente", "quarante", "cinquante", _
                       "soixante", "soixante", "quatre-vingt", "quatre-vingt")
    Else
        TabDiz = Array("", "", "vingt", "trente", "quarante", "cinquante", _
                       "soixante", "soixante", "quatre-vingt", "quatre-vingt")
    End If
    If Nombre = 0 Then
        TabUnit = Array("zéro")
    Else
        TabUnit = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
                        "huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", _
                        "seize", "dix-sept", "dix-huit", "dix-neuf")
    End If
    If Langue = 1 Then
        TabDiz(7) = "septante"
        TabDiz(9) = "nonante"
    ElseIf Langue = 2 Then
        TabDiz(7) = "septante"
        TabDiz(8) = "huitante"
        TabDiz(9) = "nonante"
    End If
    byDiz = Int(Nombre / 10)
    byUnit = Nombre - (byDiz * 10)
    strLiaison = "-"
    If byUnit = 1 Then strLiaison = " et "
    Select Case byDiz
        Case 0
            strLiaison = " "
        Case 1
            byUnit = byUnit + 10
            strLiaison = ""
        Case 7
            If Langue = 0 Then byUnit = byUnit + 10
        Case 8
            If Langue <> 2 Then strLiaison = "-"
        Case 9
            If Langue = 0 Then
                byUnit = byUnit + 10
                strLiaison = "-"
            End If
    End Select
    ConvNumDizaine = TabDiz(byDiz)
    If byDiz = 8 And Langue <> 2 And byUnit = 0 Then ConvNumDizaine = ConvNumDizaine & "s"
    If TabUnit(byUnit) <> "" Then
        ConvNumDizaine = ConvNumDizaine & strLiaison & TabUnit(byUnit)
    Else
        ConvNumDizaine = ConvNumDizaine
    End If
End Function

Private Function ConvNumCent(Nombre As Integer, Langue As Byte) As String
Dim TabUnit As Variant
Dim byCent As Byte, byReste As Byte
Dim strReste As String

    TabUnit = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
                    "huit", "neuf", "dix")
    byCent = Int(Nombre / 100)
    byReste = Nombre - (byCent * 100)
    strReste = ConvNumDizaine(byReste, Langue, False)
    Select Case byCent
        Case 0
            ConvNumCent = strReste
        Case 1
            If byReste = 0 Then
                ConvNumCent = "cent"
            Else
                ConvNumCent = "cent " & strReste
            End If
        Case Else
            If byReste = 0 Then
                ConvNumCent = TabUnit(byCent) & " cents"
            Else
                ConvNumCent = TabUnit(byCent) & " cent " & strReste
            End If
    End Select
End Function

Private Function Nz(strNb As String) As String
    If strNb <> " zéro" Then Nz = strNb
End Function

Cordialement.

Bonjour à tous,
@Mdo 100 et @3GB, un très grand merci à Vous! vraiment vous m'avez dépanner!!!

Rechercher des sujets similaires à "supprimer virgule changer devise macro nblettre"