Copier une image depuis une feuille Excel et la coller dans Word à un emplacement précis

[zephir94]

Bonjour à tous,

Je voudrais récupérer une image qui est dans une feuille de mon classeur Excel (Image61) et la coller dans un document Word, mais à un emplacement bien précis du document Word.

J'ai crée une zone Texte qui se nomme Text box 2.

J'arrive à la trouver mais mon code bloque quand j'essai de coller mon image dedans !

Voici le code :

Set Ledoc = traitementTexte.Documents.Open(ActiveWorkbook.Path & "/DOC/SYSTEM/BE.doc")
For Each Ma_Forme In Feuil3.Shapes
Feuil3.Select
If Ma_Forme.Name = "Image61" Then
Feuil3.Shapes("Image61").Copy
For Each objet In Ledoc.Shapes
  Zone = (objet.Name)
Next objet
Ledoc.Shapes(Zone).Select
With Ledoc.Shapes(Zone)
.Selection.Paste
End With
Exit For
Else
End If
Next Ma_Forme

arrivé à :

.Selection.Paste

J'ai une erreur 438, propriété ou non gérée par cet objet

Merci par avance pour vos aides

 

[Staple1600]

Bonjour le fil, le forum, zephir94

@zephir94

mais à un emplacement bien précis du document Word.

Et donc où exactement ?

 

[zephir94]

Bonjour Ce lien n'existe plus,

Je viens de trouver

Set Ledoc = traitementTexte.Documents.Open(ActiveWorkbook.Path & "/DOC/SYSTEM/BE.doc")
For Each Ma_Forme In Feuil3.Shapes
Feuil3.Select
If Ma_Forme.Name = "Image61" Then
Feuil3.Shapes("Image61").Copy
For Each objet In Ledoc.Shapes
  zone = (objet.Name)
Next objet
Ledoc.Shapes(zone).Select
With Ledoc.Shapes(zone)
Ledoc.Shapes(zone).TextFrame.TextRange.Paste
Application.CutCopyMode = False
End With
Exit For
Else
End If
Next Ma_Forme

Donc pour coller mon image depuis Excel dans une zone de texte il faut utiliser

Ledoc.Shapes(zone).TextFrame.TextRange.Paste

Sachant que Zone est le nom de la zone de texte où se situe l'emplacement où je voulais coller mon image

Merci à vous tous

 

[Staple1600]

Re

@zephir94
Merci de ton retour
Mais normalement une TextBox comme son nom l'indique est censé recevoir du Texte non?
Pas une image...

PS: Pourquoi ne pas avoir l'intégralité de ta macro???
Il nous manque les déclarations des variables et les
Sub NomMacro()
...
End Sub

 

[zephir94]

Et bien Staple1600 non

Attention c'est une Textbox Word ! que je rempli depuis Excel son tom Text box 2 m'a été donné grâce à la boucle qui balaye les objets dans le document Word.

voici le code :

Private Sub Image56_Click() ' Valider la saisie pour courrier au départ
    Dim X$, s, Y$
    Dim u As String
    Dim txt As String
    Dim traitementTexte As Word.Application
    Dim section As Word.section
    Dim Word As Word.Application
    Dim objet As Variant
    Dim STDprinter As String
    Dim strName As String
Application.ScreenUpdating = False
Set traitementTexte = New Word.Application
traitementTexte.Visible = True
Dte = CDate(UserForm8.TextBox3.Value)
MyStr = SansAccent(UCase(Format(CDate(Dte), "dddd dd mmmm yyyy")))
Set Ledoc = traitementTexte.Documents.Open(ActiveWorkbook.Path & "/DOC/SYSTEM/TA.doc")
For Each Ma_Forme In Feuil3.Shapes
Feuil3.Select
If Ma_Forme.Name = "Image61" Then
Feuil3.Shapes("Image61").Copy
For Each objet In Ledoc.Shapes
  zone = (objet.Name)
Next objet
Ledoc.Shapes(zone).Select
With Ledoc.Shapes(zone)
Ledoc.Shapes(zone).TextFrame.TextRange.Paste
Application.CutCopyMode = False
End With
Exit For
Else
End If
Next Ma_Forme
Ledoc.Content.Find.Execute findtext:="<BALISE1>", ReplaceWith:="" & "" & Feuil3.Range("A1").Value, Replace:=wdReplaceAll
Ledoc.Content.Find.Execute findtext:="<BALISE2>", ReplaceWith:="" & "" & UserForm8.Label35.Caption, Replace:=wdReplaceAll
Ledoc.Content.Find.Execute findtext:="<BALISE3>", ReplaceWith:="" & "" & UserForm8.ComboBox1.Value, Replace:=wdReplaceAll
Ledoc.Content.Find.Execute findtext:="<BALISE4>", ReplaceWith:="" & "" & Feuil3.Range("A6").Value, Replace:=wdReplaceAll
Ledoc.Content.Find.Execute findtext:="<BALISE5>", ReplaceWith:="" & "" & Feuil3.Range("A7").Value, Replace:=wdReplaceAll
Ledoc.Content.Find.Execute findtext:="<BALISE6>", ReplaceWith:="" & "" & Feuil3.Range("A1").Value, Replace:=wdReplaceAll
Ledoc.Content.Find.Execute findtext:="<BALISE7>", ReplaceWith:="" & "" & LCase(MyStr), Replace:=wdReplaceAll
If UserForm8.TextBox7.Enabled = True Then
message = UCase(UserForm8.TextBox7.Value)
Else
message = UCase(UserForm8.ComboBox7.Value)
End If
If UserForm8.TextBox6.Enabled = True Then
message = UserForm8.TextBox6.Enabled
Else
For Ij = 0 To UserForm8.ListBox1.ListCount - 1
mess2 = UserForm8.ListBox1.List(Ij)
Message2 = Message2 & " " & mess2 & vbCrLf
Next
End If
mess = message & vbCrLf & Message2
Ledoc.Content.Find.Execute findtext:="<BALISE8>", ReplaceWith:="" & "" & mess, Replace:=wdReplaceAll
Ledoc.Content.Find.Execute findtext:="<BALISE9>", ReplaceWith:="" & "" & UserForm8.TextBox2.Value, Replace:=wdReplaceAll
Ledoc.Content.Find.Execute findtext:="<BALISE10>", ReplaceWith:="" & "" & UserForm8.TextBox4.Value, Replace:=wdReplaceAll
Ledoc.Content.Find.Execute findtext:="<BALISE11>", ReplaceWith:="" & "" & Feuil3.Range("A2").Value & " " & UCase(Feuil3.Range("C2").Value), Replace:=wdReplaceAll
If UserForm8.TextBox5.Enabled = True Then
sms = UserForm8.TextBox5.Value
Else
For iA = 1 To UserForm8.ListView4.ListItems.Count
liaison1 = UserForm8.ListView4.ListItems(iA).ListSubItems(2)
If iA = 1 Then
sms = sms & "" & liaison1
Else
sms = sms & " - " & liaison1
End If
Next
End If
Ledoc.Content.Find.Execute findtext:="<BALISE12>", ReplaceWith:="" & "" & sms, Replace:=wdReplaceAll
Mod1 = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" & " - " & Feuil3.Range("A5").Value
With Ledoc
.PageSetup.DifferentFirstPageHeaderFooter = True
.Sections(1).Footers(wdHeaderFooterFirstPage) _
.Range.Text = Mod1
End With
With Ledoc.Sections(1).Footers(wdHeaderFooterFirstPage)
.Range.Font.Name = "optimum"
.Range.Font.Size = 5
End With
Ret = imp1
STDprinter = traitementTexte.ActivePrinter
With Dialogs(wdDialogFilePrintSetup)
    .Printer = imp1
    .DoNotSetAsSysDefault = True
    .Execute
End With
Ledoc.PrintOut , Copies:=UserForm8.ComboBox6.Value
With Dialogs(wdDialogFilePrintSetup)
    .Printer = STDprinter
    .DoNotSetAsSysDefault = True
    .Execute
End With
'------------------------------------------------------>
strName = ActiveWorkbook.Path & "/DOC/" & UserForm8.Label35.Caption & " " & "TA.doc"
Ledoc.SaveAs (strName)
Ledoc.Close
SetAttr strName, vbReadOnly
traitementTexte.Quit
Set Ledoc = Nothing
End If

En même temps il y a aussi le remplissage du pied de page Word ! ça aussi ça été un grand Bonheur pour l'atteindre

With Ledoc.Sections(1).Footers(wdHeaderFooterFirstPage)
.Range.Font.Name = "optimum"
.Range.Font.Size = 5
End With
Application.ScreenUpdating = true
End sub

 

[Staple1600]

Re,

@zephir94
Ça ne change rien.
Une Zone de Texte reste une zone de Texte.
Donc logiquement on devrait y trouver du texte.

S'il s'agit de copier une image issue d'Excel, bah autant copier/coller directement l'image dans Word, non ?
(Et pour spécifier l'endroit, utiliser un signet par exemple)

PS:
Pour ce qui concerne l'entête/pied de page, il y a avait pas loin à chercher...
https://www.excel-downloads.com/thr...-excel-dans-len-tete-de-word-en-vba.20025465/

 

[zephir94]

Oui mais j'aime pas les signets j'ai déjà eu des problèmes d’effacement de ces derniers et de grosses galères !
et Chuuuuut mais j'aime bien écraser les mouches avec un marteau
Mais bon mon obstination m'a permis de découvrir que l'on peut mettre une image dans cette textbox Word

 

[Staple1600]

Re

@zephir94
Tu peux joindre un fichier word exemple quasi-vide (avec juste un X là ou tu veux coller l'image issue d'Excel)
et un fichier Excel avec un exemple d'image à copier?
Histoire que je puisse faire des tests de mon côté.

Merci.

 

[chris]

Bonjour à tous

Multipost...

J'ai indiqué le site de tatiak mais pourquoi faire simple quand on peut faire compliqué ?

 

[Staple1600]

Bonjour chris

Ouf tu m'as prévenu à temps
J'allais ouvrir mon Word

PS: Quand tu dis avoir indiqué le site de tatiak, c'est l'autre forum ?
Parce qu'ici pas lu de référence à tatiak

 

[zephir94]

Je te prépares cela

 

[zephir94]

Voilà tu peux tester

Je t'ai fait un fichier Excel avec un bouton en feuille3
avec une image dans cette feuille.
Un fichier Word avec une zone de texte
Pour que tu puisses tester sans signets.

Ps pour chris, comme dit sur l'autre forum je suis allergique aux signets déjà utilisés dans le passé.
Disparition de ces derniers, effacement par les secrétaires......... donc effectivement j'ai continué ma route vers les zones de textes qui une fois la bordure mise en blanc sont invisibles.
Et puis un peu de challenge de temps en temps ça ne fait pas de mal et cela permet de découvrir de nouvelles choses

 

[Staple1600]

Re

@zephir94
[Précisons]
Concernant le multipostage, en général, c'est apprécié de savoir quand une question est posés à plusieurs endroits
(et ce par un simple lien mis dans le premier message par le demandeur)
Et cela ne date pas d'hier
Voir le point 5) dans ce lien
http://usenetfr.free.fr/BU.htm
[/précisions]

 

[zephir94]

J'ai effectivement posté sur Deux forums et non sur plusieurs car bien souvent les réponses sont différentes et complémentaires.
La règle de le dire je ne le savais pas et je le prends pour moi.
Mais n'étant pas du genre à attendre une réponse toute cuite je continu a chercher et tester de mon côté et si je trouve avant je poste la réponse.
C'est aussi le but de partager avec un esprit communautaire non ?

 

[Staple1600]

Re

Donc résultat de mon test

Sub test()
Dim wrdO, wrdF
Set wrdO = CreateObject("Word.Application"): wrdO.Visible = True
Set wrdF = wrdO.Documents.Open(Filename:=ThisWorkbook.Path & "\AT.doc")
Feuil3.Shapes("Image61").Copy
With wrdF.Paragraphs(wrdF.Paragraphs.Count).Range
.Paste: .Paragraphs.Alignment = 1
End With
End Sub

PS: J'ai supprimé au préalable la zone de texte qui ne demandait qu'à vivre sa vie de zone de texte
Test OK sur mon PC avec tes fichiers exemple

[précisions sur les précisions précédentes]
*Signaler par un lien qu'on posé sa question sur plusieurs forums permet au "répondeur"
1) d'éviter de perdre son temps à cogiter sur une question potentiellement résolue ailleurs
2) de poser une réponse déjà déposée ailleurs
3) de découvrir de nouvelles ressources dédiées à Excel
*: C'est donc toujours mieux que ce soit "le demandeur" qui le fasse dès son premier message dans la discussion qu'il s'apprête à créer.
[précisions sur les précisions précédentes]