XL 2016 Aide sur la fonction ConvNumberLetter

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
D

DARRIEUX

XLDnaute Nouveau
Bonjour,
Je souhaite établir les dons et reçus fiscaux grâce fichier joint et publipostage PDF avec ou pas envoi mails
Sur le reçu il y a le montant en chiffres et je souhaite également transformer ce montant par du texte. J'ai téléchargé la fonction ConvNumberLetter. C'est bien, sauf que le mot virgule apparait dans le texte et je n'ai pas centimes pour les montants avec centimes.

Je viens vous demander de regarder le fichier Excel et me trouver la solution.

Encore Merci

Cordialement
 

Pièces jointes

Trier par date Trier par votes
1748104744612.png

EURO | FranceTerme | Culture

www.culture.fr www.culture.fr
 
Vote positif 0 Vote négatif
re
il fallait aller cherche la FSB
le francais tout court

VB: 
'*************************************
'Nombre en lettre FR 2021/2022
'monnaie euro ou virgule
'auteur: patricktoulon
'date version: 1.3 04/12/2021
'*************************************
Option Explicit

Sub testx()
    MsgBox NbtolettreFR("0.1")
End Sub

Function NbtolettreFR(chaine As String, Optional fric As String = "")
    Dim It&, TR$, diz, Ul, c, d, u, I&, Tranche, monnaie$, Ctme$, Chain$, T, X&, Ch, Et$, Entier$, Dec$, de$
    Chain = Replace(chaine, ".", ",")    'reformatage du nombre avec virgule
    If CDbl(Chain) = 0 Then NbtolettreFR = "zero" & monnaie: Exit Function
    Tranche = Array(" nonilliard", " nonillion", " octilliard", " octillion", " septilliard", " septillion", " sextilliard", " sextillion", " quintilliard", " quintillion", " quadrilliard", " quadrillion", " trilliard", " trillion", " billiard", " billion", " milliard", " million", " mille", "")
    Ul = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf")
    diz = Array("", "dix", "vingt", "trente", "quarante", "cinquante", "soixante", "soixante-dix", "quatre-vingt", "quatre-vingt-dix", "cent")
    If Chain = "" Then NbtolettreFR = "chaine vide!": Exit Function

    T = Split(Chain, ",")    'on coupe (entier/decimal)
    monnaie = IIf(UBound(T) = 1, " virgule ", ""): Ctme = ""
    If UBound(T) = 1 Then T(1) = Left("0" & T(1) & "0", 3)
    If fric = "euro" Then fric = "fr": de = IIf(Len(Chain) > 6 And Val(Right(Chain, 6)) = 0, " d'", " "): monnaie = " euro" & IIf(T(0) > 1, "s", " "): Ctme = " centime"
    If UBound(T) = 1 Then
        If T(1) > 0 And monnaie <> " virgule " Then Ctme = Ctme & IIf(T(1) > 1, "s", "") Else Ctme = ""
        If Val(T(0)) = 0 And Ctme <> "" Then Ctme = Ctme & IIf(monnaie Like "*euro*", " d'", " ") & monnaie
        monnaie = IIf(T(1) > 0 And monnaie <> " virgule ", monnaie & " et ", monnaie)
    End If

    If Int(Val(Chain)) = 0 And monnaie <> " virgule " Then monnaie = ""
    If Int(Chain) = Chain Then Ctme = ""
    For X = 0 To UBound(T)
        If Int(Chain) = 0 And CDbl(Chain) > 0 And monnaie = " virgule " And X = 0 Then Ul(0) = "zéro" Else Ul(0) = ""
        Ch = Split(Format(T(X), "#,##0"), Chr(160))
        It = UBound(Tranche) - UBound(Ch)
        For I = 0 To UBound(Ch)
            Ch(I) = Format(Ch(I), "000")
            Select Case True: Case Ch(I) > 0: TR = Tranche(It + I) & IIf(It + I < UBound(Tranche) - 1 And Ch(I) > 1, "s", ""): Case Else: TR = "": Ch(I) = "": End Select
            c = IIf(Val(Ch(I)) < 100, "", Left(Ch(I), 1)): If c <> "" Then c = IIf(c > 1, Ul(c), Ul(0)) & IIf(c > 1, " ", "") & "cent" & IIf(Val(Ch(I)) Mod 100 = 0 And Ch(I) <> 100, "s", " ")
            d = Mid(Ch(I), 2, 1): u = Right(Ch(I), 1)
            If d Like "[1,7,9]" And u > 0 And fric = "fr" Then d = d - 1: u = u + 10:
            Et = IIf(d Like "[2,3,4,5,6,7]" And (u = 1 Or u = 11), " et ", " ")
            d = diz(Val(d)) & IIf(Val(d) = 8 And u = 0, "s", ""): u = Ul(Val(u))
            If Ch(I) = 1 And TR = " mille" Then u = ""
            Ch(I) = Replace(Application.Trim(c & d & Et & u), " ", "-") & TR
        Next
        Select Case X: Case 0: Entier = Trim(Join(Ch)): Case 1: Dec = Trim(Join(Ch)): End Select
        c = "": d = "": u = "": Et = "":
    Next
    NbtolettreFR = Application.Trim(Entier & de & monnaie & Dec & Ctme)
End Function

ou la FSB
Code: 
'*************************************
'Nombre en lettre Special pays francophone
'Suisse  Belgique France
'monnaie euro , CHF(franc suisse),CFA(monnaie francais en afrique) , CFP(franc pacifique territoire francais outre mer)
'auteur: patricktoulon
'date version: 1.3 04/12/2021
'*************************************
Option Explicit

Sub testx()
    MsgBox NbToLettresFSB("0.1", "chf")
End Sub

Function NbToLettresFSB(chaine As String, Optional region As String = "")
    Dim It, TR, diz, Ul, c, d, u, dix, I&, Tranche, monnaie$, Ctme$, Chain$, T, X&, Ch, Et$, Entier$, Dec$, de, q
    Tranche = Array(" nonilliard", " nonillion", " octilliard", " octillion", " septilliard", " septillion", " sextilliard", " sextillion", " quintilliard", " quintillion", " quadrilliard", " quadrillion", " trilliard", " trillion", " billiard", " billion", " milliard", " million", " mille", "")
    Ul = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf")
    diz = Array("", "dix", "vingt", "trente", "quarante", "cinquante", "soixante", "soixante-dix", "quatre-vingt", "quatre-vingt-dix", "cent")
    Chain = Replace(chaine, ".", ",")    'reformatage du nombre avec virgule
    'If Chain = "" Then NbToLettresFSB = "chaine vide!": Exit Function
If Chain = "" Then NbToLettresFSB = "": Exit Function

    T = Split(Chain, ",")    'on coupe (entier/decimal)
    monnaie = IIf(UBound(T) = 1, " virgule ", ""): Ctme = ""
    If UBound(T) = 1 Then T(1) = Left("0" & T(1) & "0", 3)
    region = LCase(region)
    Select Case region
    Case "be": diz(7) = "septante": diz(9) = "nonante":
    Case "se": diz(7) = "septante": diz(8) = "huitante": diz(9) = "nonante": region = "se"
    Case "euro": If region = "euro" Then region = "fr": de = IIf(Len(Chain) > 6 And Val(Right(Chain, 6)) = 0, " d'", " "): monnaie = " euro" & IIf(T(0) > 1, "s", " "): Ctme = " centime"
    Case "beuro": diz(7) = "septante": diz(9) = "nonante": region = "be": Ctme = " centime": de = IIf(Len(Chain) > 6 And Val(Right(Chain, 6)) = 0, " d'", ""): monnaie = " euro" & IIf(T(0) > 1, "s", " ")
    Case "chf": diz(7) = "septante": diz(8) = "huitante": diz(9) = "nonante": monnaie = " CHF ": region = "se": Ctme = " centime"
    Case "cfp", "cfa": de = IIf(Len(Chain) > 6 And Val(Right(Chain, 6)) = 0, " de ", ""): monnaie = " Franc" & IIf(T(0) > 1, "s ", " ") & UCase(region): region = "fr":: Ctme = " centime"
    Case Else: region = "fr"
    End Select
    If UBound(T) = 1 Then
        If T(1) > 0 And monnaie <> " virgule " Then Ctme = Ctme & IIf(T(1) > 1, "s", "") Else Ctme = ""
        If Val(T(0)) = 0 And Ctme <> "" Then Ctme = Ctme & IIf(Left(Trim(LCase(monnaie)), 1) Like "[a,e,i,o,u,y]", " d'", IIf(monnaie <> " CHF ", " de", "")) & monnaie
        monnaie = IIf(T(1) > 0 And monnaie <> " virgule ", monnaie & " et ", monnaie)
    End If

    If CDbl(Chain) = 0 Then NbToLettresFSB = "zero" & monnaie: Exit Function
    If Int(Val(Chain)) = 0 And monnaie <> " virgule " Then monnaie = ""
    If Int(Chain) = Chain Then Ctme = ""
    For X = 0 To UBound(T)
        If Int(Chain) = 0 And CDbl(Chain) > 0 And monnaie = " virgule " And X = 0 Then Ul(0) = "zéro" Else Ul(0) = ""
        Ch = Split(Format(T(X), "#,##0"), Chr(160))     '----->abandon de la rectification du formatage avec les zéros manquants
        It = UBound(Tranche) - UBound(Ch)
        For I = 0 To UBound(Ch)
            Ch(I) = Format(Ch(I), "000")    ' c'est dans chaque tranches que l'on formate a 3 chiffres
            Select Case True: Case Ch(I) > 0: TR = Tranche(It + I): Case Else: TR = "": Ch(I) = "": End Select
            If TR <> " mille" And TR <> "" And Val(Ch(I)) > 1 Then TR = TR & "s"
            c = IIf(Val(Ch(I)) < 100, "", Left(Ch(I), 1)): If c <> "" Then c = IIf(c > 1, Ul(c), Ul(0)) & IIf(c > 1, " ", "") & "cent" & IIf(Val(Ch(I)) Mod 100 = 0 And Ch(I) <> 100, "s", " ")
            d = Mid(Ch(I), 2, 1): u = Right(Ch(I), 1)
            If d Like "[7,9]" And u > 0 And region = "fr" Then d = d - 1: u = u + 10:
            If d = 1 And u > 0 Then d = d - 1: u = u + 10:
            Et = IIf(d Like "[2,3,4,5,6,7,9]" And (u = 1 Or u = 11), " et ", " "): Et = IIf(region = "se" And d = 8 And u = 1, " et ", Et)
            d = diz(Val(d)) & IIf(Val(d) = 8 And u = 0 And "befr" Like "*" & region & "*", "s", ""): u = Ul(Val(u))
            If Ch(I) = 1 And TR = " mille" Then u = ""
            Ch(I) = Replace(Application.Trim(c & d & Et & u), " ", "-") & TR
        Next
        Select Case X: Case 0: Entier = Trim(Join(Ch)): Case 1: Dec = Trim(Join(Ch)): End Select
        c = "": d = "": u = "": Et = "":
    Next
    NbToLettresFSB = Application.Trim(Entier & de & monnaie & Dec & Ctme)
End Function
1748106551390.png
 
Vote positif 0 Vote négatif
Hi,
Juste pour le fun...
Les Francs CFP (Polynésie, Nouvelle-Calédonie, W et F, ....) ont pour symbole "XPF"
Et l'utilisation de centimes en XPF??? (je crois que les centimes n'existent pas en XPF, mais à vérifier...)
Enjoy
Bonne soirée
PS, Wiki montre bien les pièces et les billets du franc CFP, mais ne parle nullement des centimes
PS2, j'y ai pourtant vécu pendant 6 ans (4 ans en NC, 2 ans en PF), je devrais m'en souvenir.... C'est moche de vieillir... 🙂
 
Dernière édition:
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

R
  • Question Question
XL 2019 Aide à la création d'un fichier de saisie et suivi des engagements budgétaires sous Excel
Réponses
2
Affichages
187
Royaulté
R
J
  • Résolu(e)
XL 2019 Important : Nommer fichier grâce aux éléments de publipostage
Réponses
6
Affichages
736
JacquesO
J
C
  • Question Question
XL 2016 Aide sur la fonction recherche V ou autre
Réponses
4
Affichages
460
cece44
C
Y
  • Question Question
XL 2016 Création d'un publipostage avec PJ PDF sur Outlook
Réponses
2
Affichages
324
Phil69970
Phil69970
Arthur1979
  • Question Question
Microsoft 365 formule sur Excel qui affiche un montant en fonction du texte
Réponses
5
Affichages
732
job75
job75
H
  • Question Question
XL 2013 Saisie sécurisée numéros de téléphone et ajout fonction clic droit de la souris
2
Réponses
21
Affichages
859
Helios77
H
M
  • Résolu(e)
XL pour MAC Fonction peut s'adapter au changement de ligne ?
Réponses
4
Affichages
615
MaiBZH
M
E
  • Résolu(e)
XL 2021 Problème d'importation de données à partir d'un fichier Excel vers un autre fichier Excel en utilisant VBA
Réponses
3
Affichages
833
eCHO
E
D
  • Résolu(e)
Microsoft 365 fonction de recherche multiple
Réponses
3
Affichages
544
dd_76
D
kmi08
  • Question Question
XL 2019 aide sur formule couleur en fonction d'une liste de nom affecté
Réponses
3
Affichages
572
kmi08
kmi08
L
  • Question Question
XL 2016 aide sur un tableau
Réponses
4
Affichages
577
laurent57970
L
T
  • Question Question
Autres Fonction/Macros Excel collecter des montants
Réponses
8
Affichages
726
cp4
cp4
F
  • Question Question
XL pour MAC Envoi de rappel automatique de rdv adressé au client à partir d'une feuille excel
Réponses
2
Affichages
771
fred936
F
A
  • Question Question
Microsoft 365 Formules SI imbriqués : erreur dans la formule
Réponses
14
Affichages
668
gbinforme
G
S
  • Résolu(e)
Outlook Mails personnalisés en masse avec pièce jointe Pdf via Outlook et Excel
Réponses
5
Affichages
3 K
steph_29120
S
E
  • Question Question
XL 2019 Peut-on créer automatiquement un lien hypertexte en fonction du contenu de la cellule ?
Réponses
1
Affichages
979
vgendron
vgendron
K
  • Résolu(e)
Microsoft 365 EXCEL Supprimer 1ere ligne sur plusieurs cellules
Réponses
10
Affichages
726
KG61
K
W
  • Question Question
XL 2010 Publipostage Word Excel en joignant si possible automatuqement un fichier pdf et un fichier excell
Réponses
0
Affichages
2 K
willoweiss
W
T
  • Question Question
Microsoft 365 Créer rapport excel par Contractant en fonction de la (J) et avoir la possibilité de faire un Email via Outlook
Réponses
2
Affichages
599
tututi
T
J
  • Question Question
Autres Aide exercice excel
2 3 4
Réponses
59
Affichages
6 K
JM27
J
Retour