XL 2019 Convertir des chiffres en lettres

A

ajox01

XLDnaute Junior
Bonjour Chers experts,

J'ai besoin de votre aide. Je voudrais une fonction qui me permettra de convertir automatiquement les chiffres monétaires en lettres dans excel.

Exemple: 3 742,50 euros donnera Trois mille sept cent quarante deux Euros Cinquante centimes.

Merci d'avance de votre support

Cordialement
Ajox01
 
Trier par date Trier par votes
Staple1600

Staple1600

XLDnaute Barbatruc
Re, Bonjour patricktoulon

•>patricktoulon
Oui, c'est moi.
Et le confinement t'offre l'occasion de retrouver le fil en question ;)
(et de tester l'efficacité ou pas du moteur de recherche interne du forum)
Bonne recherche, camarade confiné ;)

PS: Si par extraordinaire, le fil n'est pas retrouvé, je posterai le lien après ma séance de jo(K-SDB-K)gging ;)
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
ben je le retrouve pas le tire ne dis pas etre cohérent avec le sujet

mais j'ai peché une macro word que j'essaie de faire fonctionner dans vba excel je n y arrive pas
VB: 
Sub NombreEnLettre()
Dim MonChamp As Object

Set appw = CreateObject("word.application")
Set docw = appw.documents.Add
appw.Visible = True
x = InputBox("Entrez un nombre")
Set MonChamp = docw.Fields.Add(Range:=Selection.Range, Text:="=" & x & " * cardtext")
MonChamp.Unlink
End Sub
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
ben oui mais le tire et le forum c 'est pas jojo
bon toujours est il qu'en fonction et épuré de tout ce qui est pas nécessaire j'aimerais bien l'avoir en latebinding histoir de lui ajouter la transportabilité ;)

VB: 
Function convert_number_to_letters_word_Object(num$)
Dim oWS As Worksheet
Dim oOLEWd As OLEObject
Dim oWD As Document, Cts$
' Dans VBE, Menu: Outils/Références:cochez: Microsoft Word XX.0 Object Library )
Cts = Split(num, ",")(1)
Application.ScreenUpdating = False
Set oWS = ActiveSheet
Set oOLEWd = oWS.OLEObjects.Add(ClassType:="Word.Document.8", Link:=False, DisplayAsIcon:=True)
Set oWD = oOLEWd.Object
oWD.Fields.Add Range:=oWD.Range, Type:=wdFieldQuote, Text:="=" & Split(num, ",")(0) & "\*CARDTEXT"
oWD.Range.Characters(Len(oWD.Range.Text)).InsertAfter " EUROS ET " 'Eureka !
oWD.Fields.Add Range:=oWD.Range.Characters(Len(oWD.Range.Text)), Type:=wdFieldQuote, Text:="=" & Cts & "\*CARDTEXT"
oWD.Range.Characters(Len(oWD.Range.Text)).InsertAfter " CENTIMES." 'Alleluia !!!
oWD.Fields.Update
convert_number_to_letters_word_Object = oWD.Range.Text
'On Error Resume Next
If Not oOLEWd Is Nothing Then oOLEWd.Delete
End Function

Sub test()
num$ = InputBox("Saisir un montant:" & Chr(13) & "Ex: 123,89", "Saisie", "123,89")
MsgBox convert_number_to_letters_word_Object(num)
End Sub

voir aussi si les 2 insert ne peuvent pas se faire en un dans la formule
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

Moi, je préfère les majuscules ;)
VB: 
Function oW_CHIFFRELETTRE(num$)
' Dans VBE, Menu: Outils/Références:cochez: Microsoft Word XX.0 Object Library )
'crédits: Staple pour l'idée de départ | patricktoulon pour l'upgrade et "épurage" ;-)
Dim oWS As Worksheet, oOLEWd As OLEObject, oWD As Document, Cts$
Cts = Split(num, ",")(1)
Application.ScreenUpdating = False
Set oWS = ActiveSheet
Set oOLEWd = oWS.OLEObjects.Add(ClassType:="Word.Document.8", Link:=False, DisplayAsIcon:=True)
Set oWD = oOLEWd.Object
oWD.Fields.Add Range:=oWD.Range, Type:=wdFieldQuote, Text:="=" & Split(num, ",")(0) & "\*CARDTEXT \*Upper"
oWD.Range.Characters(Len(oWD.Range.Text)).InsertAfter " EUROS ET " 'Eureka !
oWD.Fields.Add Range:=oWD.Range.Characters(Len(oWD.Range.Text)), Type:=wdFieldQuote, Text:="=" & Cts & "\*CARDTEXT \*Upper"
oWD.Range.Characters(Len(oWD.Range.Text)).InsertAfter " CENTIMES." 'Alleluia !!!
oWD.Fields.Update
oW_CHIFFRELETTRE = oWD.Range.Text
'On Error Resume Next
If Not oOLEWd Is Nothing Then oOLEWd.Delete
End Function

Sub test_B()
Dim NomBre As String
NomBre = InputBox("Saisir un montant:" & Chr(13) & "Ex: 1600,12", "Saisie", "1600,12")
MsgBox oW_CHIFFRELETTRE(NomBre), vbInformation, "Conversion Chiffre en Lettre"
End Sub
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
c'est pas trop ca qui me préoccupe c'est le mode latebinding que je n'arrive pas a trouver

je souhaiterais (pas cocher de reference )
et dimer
oOLEWd en object
oWD en object

pour oOLEWd ca va pas de soucis
mais pour oWD ca plante un msgbox " limite atteint "

oWD c'est quoi ?le document de oOLEWd ? ou simplement le .object de oOLEWd

VB: 
'******************************************************************************************
'basé sur l'exemple de Staple1600 (Exceldownload) version date 19/05/2012
'https://www.excel-downloads.com/threads/xl-oleobject-word-par-vba-piloter-champs.184716/
'patricktoulon upgrade et "épurage";transformation en fonction  version date 23/03/2020
'******************************************************************************************
Function CHIFFRES_LETTRES(num$)
Dim oWS As Worksheet, oOLEWd As OLEObject
'Dim Cts ,oWD As Document!!!!!!?????????
Dim Cts, oWD As Object   '!!!!!! ne fonctionne pas en latebinding (sans référence activé)
' Dans VBE, Menu: Outils/Références:cochez: Microsoft Word XX.0 Object Library )!!!!!!!!!!!!!!!
Cts = Split(Replace(num, ".", ","), ",")
Application.ScreenUpdating = False
Set oWS = ActiveSheet
With oWS.OLEObjects.Add(ClassType:="Word.Document.8", Link:=False, DisplayAsIcon:=False)
.Object.Fields.Add Range:=.Object.Range, Type:=wdFieldQuote, Text:="=" & Cts(0) & "\*CARDTEXT"
.Object.Range.Characters(Len(.Object.Range.Text)).InsertAfter " EUROS ET " 'Eureka !
.Object.Fields.Add Range:=.Object.Range.Characters(Len(.Object.Range.Text)), Type:=wdFieldQuote, Text:="=" & Cts(1) & "\*CARDTEXT"
.Object.Range.Characters(Len(.Object.Range.Text)).InsertAfter " CENTIMES." 'Alleluia !!!
.Object.Fields.Update
CHIFFRES_LETTRES = .Object.Range.Text
If Not .Object.Parent Is Nothing Then .Delete 'supression de l'oleobject word
End With
End Function

Sub test()
num$ = InputBox("Saisir un montant:" & Chr(13) & "Ex: 123,89", "Saisie", "123,89")
MsgBox CHIFFRES_LETTRES(num)
End Sub

comment se passer de la référence pour le ".object" ???????????????
 
Dernière édition:
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

Suffit d'ajouter la référence par VBA
(Il doit y avoir des exemples ici ou là)
Pour ce qui me concerne, en 2012 c'était juste un petit exercice pour ma curiosité personnelle.
(Pas pour un usage in "real life" d'autant plus que CARDTEXT ne fonctionne que jusqu'à 999 999,00)
Et n'oublions pas les Macistes, pour lesquels le code ne fonctionnera pas ;)

PS: C'est pas Staple1660 mais Staple1600 ;)
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
oui j'ai vu la limite de 999 999 c'est vraiment dommage

j'y ai pensé a l'ajouter dynamiquement mais bon j'aurais préféré trouver le clisd
j'ai ajouté le decimal ou pas et le "s" a euro selon la valeur(je sais que ça ça fait debat)
VB: 
'******************************************************************************************
'basé sur l'exemple de Staple1600 (Exceldownload) version date 19/05/2012
'https://www.excel-downloads.com/threads/xl-oleobject-word-par-vba-piloter-champs.184716/
'patricktoulon upgrade et "épurage";transformation en fonction  version date 23/03/2020
' Dans VBE, Menu: Outils/Références:cochez: Microsoft Word XX.0 Object Library )!!!!!!!!!!!!!!!
'******************************************************************************************
Function CHIFFRES_LETTRES(num$)
    Dim oWS As Worksheet, oOLEWd As OLEObject, et$, euro$
    'Dim Cts ,oWD As Document!!!!!!?????????
    Dim Cts, oWD As Object   '!!!!!! ne fonctionne pas en latebinding (sans référence activé)
      Cts = Split(Replace(num, ".", ","), ",")
    euro = "EURO"
    If Val(Cts(0)) > 999999 And Val(Cts(0)) Mod 10 = 0 Then euro = "d'" & euro 'inutile on y arrive pas avec cet object
    If Val(Cts(0)) > 1 Then euro = euro & "s"
    If UBound(Cts) = 1 Then et = " et " Else et = ""
    Application.ScreenUpdating = False
    Set oWS = ActiveSheet
    With oWS.OLEObjects.Add(ClassType:="Word.Document.8", Link:=False, DisplayAsIcon:=False)
        .Object.Fields.Add Range:=.Object.Range, Type:=wdFieldQuote, Text:="=" & Cts(0) & "\*CARDTEXT"
        .Object.Range.Characters(Len(.Object.Range.Text)).InsertAfter " " & euro & et  'Eureka !
        If UBound(Cts) = 1 Then 'si decimales
            .Object.Fields.Add Range:=.Object.Range.Characters(Len(.Object.Range.Text)), Type:=wdFieldQuote, Text:="=" & Cts(1) & "\*CARDTEXT"
            .Object.Range.Characters(Len(.Object.Range.Text)).InsertAfter " CENTIMES."    'Alleluia !!!
        End If
        .Object.Fields.Update
        CHIFFRES_LETTRES = UCase(.Object.Range.Text)
        If Not .Object.Parent Is Nothing Then .Delete    'supression de l'oleobject word
    End With
End Function

Sub test()
    num$ = InputBox("Saisir un montant:" & Chr(13) & "Ex: 123,89", "Saisie", "999999.45")
    MsgBox CHIFFRES_LETTRES(num)
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

F
  • Question
XL 2016 Formule traduisant les chiffres en lettres sans Vba
Réponses
2
Affichages
790
Fidmo
F
P
  • Question
Microsoft 365 nombre en lettres incomplet
6 7 8
Réponses
116
Affichages
5 K
Dudu2
Dudu2
Usine à gaz
  • Question
Microsoft 365 conversion chiffres en lettres qui m'enlève toujours 5
2 3 4
Réponses
57
Affichages
5 K
patricktoulon
patricktoulon
DAVID-44-
  • Question
XL 2010 Calculer selon le nom des produits en stock.
Réponses
12
Affichages
621
vgendron
vgendron
G
  • Question
XL 2013 Conversion chiffres en lettre avec 3 chiffre après la virgule
Réponses
5
Affichages
3 K
patricktoulon
patricktoulon
G
  • Question
XL 2013 Convertir chiffres en lettres en anglais avec 3 nombre après virgule
2
Réponses
23
Affichages
4 K
patricktoulon
patricktoulon
patricktoulon
  • Résolu(e)
Autres evaluate qui donne une erreur en dynamique et bonne encodé en dur
2
Réponses
21
Affichages
2 K
eriiic
eriiic
A
  • Question
XL 2016 Formule pour convertir des chiffres en lettres
Réponses
5
Affichages
4 K
AMIGO2
A
Brigitte 45
  • Question
Montant en € en chiffres à transformer en toutes lettres
Réponses
7
Affichages
2 K
Modeste geedee
Modeste geedee
T
  • Question
XL 2013 veuillez m’aider à réparer la fonction spellnumber et de l'avoir en arabe aussi , je vous remercie d'avance
Réponses
1
Affichages
2 K
job75
job75

Membres actuellement en ligne

23 membres et 171 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 135
Messages
2 116 619
Membres
112 815
dernier inscrit
Pierre43