Sub TestOLEOBJECT_Word()
Dim oWS As Worksheet
Dim oOLEWd As OLEObject
Dim oWD As Document, Num$
' Dans VBE, Menu: Outils/Références:cochez: Microsoft Word XX.0 Object Library )
Num = InputBox("Saisir un nombre entier" & Chr(13) & "Ex: 123", "Saisie", 123)
Application.ScreenUpdating = False
SupprimerOLEOBJECT
Set oWS = ActiveSheet
oWS.Range("C10").Select
Set oOLEWd = oWS.OLEObjects.Add(ClassType:="Word.Document.8", Link:=False, DisplayAsIcon:=False)
Set oWD = oOLEWd.Object
oWD.Fields.Add Range:=oWD.Range, Type:=wdFieldQuote, Text:="=" & Num & "\*CARDTEXT"
oWD.Range.InsertAfter " EUROS"
oWD.Fields.Update
oOLEWd.Activate
oOLEWd.Border.LineStyle = None
oOLEWd.Placement = XlPlacement.xlMoveAndSize
Range("A1").Select
End Sub
Sub TestOLEOBJECT_Word_OK()
Dim oWS As Worksheet
Dim oOLEWd As OLEObject
Dim oWD As Document, Num$, Cts$
' Dans VBE, Menu: Outils/Références:cochez: Microsoft Word XX.0 Object Library )
Num = InputBox("Saisir un montant:" & Chr(13) & "Ex: 123,89", "Saisie", "123,89")
Cts = Split(Num, ",")(1)
Application.ScreenUpdating = False
SupprimerOLEOBJECT
Set oWS = ActiveSheet
oWS.Range("C10").Select
Set oOLEWd = oWS.OLEObjects.Add(ClassType:="Word.Document.8", Link:=False, DisplayAsIcon:=False)
Set oWD = oOLEWd.Object
oWD.Fields.Add Range:=oWD.Range...
Sub SupprimerOLEOBJECT()
On Error Resume Next
ActiveSheet.DrawingObjects.Delete
End Sub
'---
oWD.Fields.Update
'Début ajout
'Mise en majuscule
oWD.Range.Font.AllCaps = True
oWD.Range.MoveEnd
oWD.Range.InsertAfter " ET "
'fin ajouts
'---
Sub TestOLEOBJECT_Word()
Dim oWS As Worksheet
Dim oOLEWd As OLEObject
Dim oWD As Document, Num$, i&
' Dans VBE, Menu: Outils/Références:cochez: Microsoft Word XX.0 Object Library )
Num = InputBox("Saisir un nombre entier" & Chr(13) & "Ex: 123", "Saisie", 123)
Application.ScreenUpdating = False
SupprimerOLEOBJECT
Set oWS = ActiveSheet
For i = 13 To 16 Step 3
oWS.Cells(i, 3).Select
Set oOLEWd = oWS.OLEObjects.Add(ClassType:="Word.Document.8", Link:=False, DisplayAsIcon:=False)
Set oWD = oOLEWd.Object
oWD.Fields.Add Range:=oWD.Range, Type:=wdFieldQuote, Text:="=" & Num & "\*CARDTEXT"
oWD.Range.InsertAfter " EUROS"
oWD.Fields.Update
oOLEWd.Activate
oOLEWd.Border.LineStyle = xlNone
oOLEWd.Placement = XlPlacement.xlMoveAndSize
Next i
Range("B1").Select
End Sub
Whouauuu ... pourquoi faire simple quand on peut faire compliquerCe que je veux pouvoir faire c'est dans Excel (et ce grâce à WORD par le biais d'un OLEOBJECT) c'est transformer un montant en chiffres en lettres.
Dim oOLEWd As OLEObject
Dim oWD As Document, Num$, i&, s, j As Double, A()
A = Array(" EUROS", " CENTIMES")
' Dans VBE, Menu: Outils/Références:cochez: Microsoft Word XX.0 Object Library )
Num = InputBox("Saisir un nombre entier" & Chr(13) & "Ex: 123", "Saisie", 123)
s = Split(Num, ",")
Application.ScreenUpdating = False
SupprimerOLEOBJECT
Set oWS = ActiveSheet
For i = 13 To 16 Step 3
oWS.Cells(i, 3).Select
Set oOLEWd = oWS.OLEObjects.Add(ClassType:="Word.Document.8", Link:=False, DisplayAsIcon:=False)
Set oWD = oOLEWd.Object
oWD.Fields.Add Range:=oWD.Range, Type:=wdFieldQuote, Text:="=" & s(j) & "\*CARDTEXT"
oWD.Range.InsertAfter A(j)
oWD.Fields.Update
oOLEWd.Activate
oOLEWd.Border.LineStyle = xlNone
oOLEWd.Placement = XlPlacement.xlMoveAndSize
j = j + 1
Next i
Range("B1").Select
End Sub
Sub MacroDansWord()
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="=128\*CARDTEXT"
Selection.MoveRight Unit:=wdCharacter, Count:=2
Selection.TypeText Text:=" EUROS ET "
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="=59\*CARDTEXT"
Selection.MoveRight Unit:=wdCharacter, Count:=2 'MoveRight ne fonctionne pas sous Excel
Selection.TypeText Text:=" CENTIMES."
Selection.MoveLeft Unit:=wdWord, Count:=6, Extend:=wdExtend 'idem
Selection.Font.AllCaps = True
Selection.Fields.Update
End Sub
Sub TestOLEOBJECT_Word_OK()
Dim oWS As Worksheet
Dim oOLEWd As OLEObject
Dim oWD As Document, Num$, Cts$
' Dans VBE, Menu: Outils/Références:cochez: Microsoft Word XX.0 Object Library )
Num = InputBox("Saisir un montant:" & Chr(13) & "Ex: 123,89", "Saisie", "123,89")
Cts = Split(Num, ",")(1)
Application.ScreenUpdating = False
SupprimerOLEOBJECT
Set oWS = ActiveSheet
oWS.Range("C10").Select
Set oOLEWd = oWS.OLEObjects.Add(ClassType:="Word.Document.8", Link:=False, DisplayAsIcon:=False)
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
oWD.Range.Font.AllCaps = True
oOLEWd.Activate
oOLEWd.Border.LineStyle = None
oOLEWd.Placement = XlPlacement.xlMoveAndSize
Range("A1").Select
End Sub
Sub SupprimerOLEOBJECT()
On Error Resume Next
ActiveSheet.DrawingObjects.Delete
End Sub