'******************************************************************************************
'basé sur l'exemple de Staple1660 (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, et$, euro$
'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 )!!!!!!!!!!!!!!!
Set ID = ThisWorkbook.VBProject.References
On Error Resume Next
ID.AddFromGuid "{00020905-0000-0000-C000-000000000046}", 1, 1 ', 8, 4
Err.Clear
re:
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
If UCase(.Object.Range.Text) Like "*EUROS ET CENTIMES." Then GoTo re
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
