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 Staple1600,

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
 

Staple1600

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

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/threads/copier-un-tableau-excel-dans-len-tete-de-word-en-vba.20025465/#post-20192568
 

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
 

Staple1600

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

XLDnaute Barbatruc
Bonjour à tous

Multipost...

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

Staple1600

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

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

Fichiers joints

Dernière édition:

Staple1600

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

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]
 

zephir94

XLDnaute Impliqué
Certes Staple1600,
Mais on me proposait uniquement les signets chose que je ne voulait pas utiliser ;)
VB:
Paragraphs
C'est quoi ? un signets ? tu peux m'en dire plus ?
J'ai utilisé il y a quelques temps les signets et ça a été une bérésina.
Tous les deux jours j'étais obligé de remettre le doc Word sur le serveur !!!
 

Staple1600

XLDnaute Barbatruc
Re

@zephir94
Certes, quoi ?
Peu importe ce quel'on a t'a proposé, le fait est que dans ton premier message, nulle part tu indiques que ta question est posée sur plusieurs forums.
Du coup, j'aurai pu me retrouver dans les 3 points évoqués dans le message#15 ;)

PS:
Tu as testé ma macro test sur ton PC ?
Cela fonctionne ou pas?
 

zephir94

XLDnaute Impliqué
Oui j'ai testé et ça marche parfaitement et je t'en remercie infiniment, mais moi cette image représente en fait une signature d'ou mon intérêt
de devoir la positionner exactement là où je le souhaite :D
Du coup comment avec ton exemple comment lui imposer un emplacement défini ?
 

zephir94

XLDnaute Impliqué
Et bien là était mon problème à un endroit précis du document sous des champs vers le bas de page juste en dessous du Nom du responsable.
D’où mes recherches pour L’insérer sous le nom de ce dernier.
Le côté pratique de ma zone de texte est que je peux la déplacer où je le veux :rolleyes:
 

Discussions similaires


Haut Bas