XL 2019 Convertir des chiffres en lettres

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
 

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 ;)
 

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
 

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
 

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
 

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:

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 ;)
 

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:

Discussions similaires

Réponses
116
Affichages
3 K