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

zephir94

XLDnaute Impliqué
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 :
VB:
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é à :

VB:
.Selection.Paste

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

Merci par avance pour vos aides
 

zephir94

XLDnaute Impliqué
Bonjour Ce lien n'existe plus,

Je viens de trouver

VB:
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

VB:
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
 

zephir94

XLDnaute Impliqué
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 :

VB:
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 o_O

VB:
With Ledoc.Sections(1).Footers(wdHeaderFooterFirstPage)
.Range.Font.Name = "optimum"
.Range.Font.Size = 5
End With
Application.ScreenUpdating = true
End sub
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
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

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

zephir94

XLDnaute Impliqué
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 ;)
 

Pièces jointes

  • projet messagerie.zip
    39.7 KB · Affichages: 31
Dernière édition:

zephir94

XLDnaute Impliqué
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

XLDnaute Barbatruc
Re

Donc résultat de mon test
VB:
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]
 

Discussions similaires

Statistiques des forums

Discussions
311 709
Messages
2 081 766
Membres
101 815
dernier inscrit
sgep59