Coller depuis Excel vers Word image tableau + image graph

Bonjour,

J'ai un fichier Excel "source" dont je souhaite exporter le contenu vers un fichier word "rapport".

Le fichier word "rapport" (modele_word.dotm) contient 3 signets : "titre_du_rapport", "tableau_resultats" et "graphique".

Avec le code ci-dessous je parviens à récupérer le nom du rapport depuis Excel, l'écrire dans word et l'utiliser pour le nom du fichier Word sauvegardé.

Le code permet de copier le tableau depuis Excel et le colle dans Word en tant que tableau et non en tant qu'image du tableau copié. Je n'ai pas trouvé le bon attribut pouvez vous m'aider ?

Pour la récupération du graphique, qui est dans un onglet "Graph1" j'ai essayé plusieurs pistes mais sans succès, je n'arrive pas à le sélectionner puis le copier, en tant qu'image à nouveau, au niveau du signet Word "graphique"... Est ce que quelqu'un aurait une idée ?

Les autres posts du forum m'ont donné des pistes mais je ne parviens pas à tout relier ensemble. Merci pour votre aide.

Mon code est le suivant :

Sub Export_Word()

Dim Doc_origine As String, Doc_save As String

Dim WordApp As Object

Dim WordDoc As Object

Doc_origine = ActiveWorkbook.Path & "\modele_word.dotm"

Doc_save = ActiveWorkbook.Path & "\" & Sheets("Feuil1").Range("A1").Text & ".docx"

Set WordApp = CreateObject("word.application")

Set WordDoc = WordApp.Documents.Open(Doc_origine, ReadOnly:=False)

WordApp.Visible = False

WordDoc.Bookmarks("titre_du_rapport").Range.Text = Cells(1, 1)

'pour copier le tableau dans word

ThisWorkbook.Worksheets("Feuil1").Range("C3:H22").Copy

WordDoc.Bookmarks("tableau_resultats").Range.PasteSpecial

Application.CutCopyMode = False

WordApp.Visible = True

WordDoc.Application.ActiveDocument.SaveAs Doc_save

End Sub

Bonsoir,

il me semble que cette correction devrait faire l'affaire :

ThisWorkbook.Worksheets("Feuil1").Range("C3:H22").CopyPicture

Merci Thev effectivement j'ai bien une image du tableau

L'attribut pour permettre pour que l'image soit alignée sur le texte dans le doc word et non ancrée par dessus le texte est :

"< WordDoc.Bookmarks("tableau_resultats").Range.PasteSpecial Placement:=wdInLine >"

Ceci étant est ce que quelqu'un aurait une idée pour le collage du graphique en tant qu'image ? car ce que j'ai pu essayer ne semble pas fonctionner ... je ne parviens même pas à récupérer le graphique

Une dernière question comment intégrer des lignes de code pour qu'elles apparaissent non pas en texte mais en "code" (fenêtre dédiée + typo) ?

omment intégrer des lignes de code pour qu'elles apparaissent non pas en texte mais en "code" (fenêtre dédiée + typo) ?

il suffit d'utiliser la balise "</>"

ok merci Thev, mais je crois que je n'ai pas réussi à utiliser ces balises...

Quoiqu'il en soit j'ai avancé un peu sur mon problème : j'ai réussi à copier le graph .... mais pas en tant qu'image

Si quelqu'un a une idée ... je suis preneur !

"<

Option Explicit

Sub Export_Word_EGe()

Dim Doc_origine As String

Dim Doc_save As String

Dim chemin_fichier_excel As String

Dim chemin_et_nom_fichier_excel As String

Dim nom_fichier As String

Dim WordApp As Object

Dim WordDoc As Object

Dim wdApp As Word.Application

Dim wdDoc As Word.Document

Dim wdRng As Word.Range

chemin_fichier_excel = Application.ActiveWorkbook.Path

'MsgBox chemin_fichier_excel

chemin_et_nom_fichier_excel = Application.ActiveWorkbook.FullName

'MsgBox chemin_et_nom_fichier_excel

nom_fichier = Application.ActiveWorkbook.Name

'MsgBox nom_fichier

Doc_origine = ActiveWorkbook.Path & "\modele_word.dotm"

Doc_save = ActiveWorkbook.Path & "\" & Sheets("Feuil1").Range("B1").Text & ".docx"

Set WordApp = CreateObject("word.application")

Set WordDoc = WordApp.Documents.Open(Doc_origine, ReadOnly:=False)

WordApp.Visible = False

WordDoc.Bookmarks("titredurapport").Range.Text = Cells(1, 2)

WordDoc.Bookmarks("autreinfo2").Range.Text = Cells(2, 2)

WordDoc.Bookmarks("autreinfo3").Range.Text = Cells(3, 2)

WordDoc.Bookmarks("autreinfo4").Range.Text = Cells(4, 2)

WordDoc.Bookmarks("autreinfo5").Range.Text = Cells(5, 2)

WordDoc.Bookmarks("autreinfo6").Range.Text = Cells(6, 2)

WordDoc.Bookmarks("autreinfo7").Range.Text = Cells(7, 2)

WordDoc.Bookmarks("autreinfo8").Range.Text = Cells(8, 2)

WordDoc.Bookmarks("autreinfo9").Range.Text = Cells(9, 2)

WordDoc.Bookmarks("autreinfo10").Range.Text = Cells(10, 2)

WordDoc.Bookmarks("autreinfo11").Range.Text = Cells(11, 2)

WordDoc.Bookmarks("autreinfo12").Range.Text = Cells(112, 2)

WordDoc.Bookmarks("autreinfo13").Range.Text = Cells(13, 2)

'--------------------

'Debut copie tableau

'--------------------

'pour copier le tableau dans word : le tableau reste modifiable

'ThisWorkbook.Worksheets("Feuil1").Range("C3:H22").Copy

'pour copier le tableau dans word en tant qu image

ThisWorkbook.Worksheets("Feuil1").Range("C3:H22").CopyPicture

'image ancrée devant le texte

'WordDoc.Bookmarks("tableau_resultats").Range.PasteSpecial

'image ancrée sur la ligne de texte

WordDoc.Bookmarks("tableau_resultats").Range.PasteSpecial Placement:=wdInLine

Application.CutCopyMode = False

WordApp.Visible = True

WordDoc.Application.ActiveDocument.SaveAs Doc_save

'------------------

'Fin copie tableau

'------------------

'----------------------

'Debut copie graphique

'----------------------

Workbooks(nom_fichier).Activate

' affiche un message si le graphique n'est pas sélectionné au début de l execution de la macro

If ActiveChart Is Nothing Then

MsgBox "sélectionner le graphique au début, recommancer!", vbExclamation, "Export d'un graph vers word"

Exit Sub

End If

' vérification si word est déjà ouvert

On Error Resume Next

Set wdApp = GetObject(, "Word.Application")

On Error Resume Next

If wdApp Is Nothing Then

' si word est inactif alors il est lancé et un nouveau document est ouvert

Set wdApp = CreateObject("Word.Application")

Set wdDoc = wdApp.Documents.Open(Doc_save)

Else

If wdApp.Documents.Count > 0 Then

' sélectionne le doc word actif

Set wdDoc = wdApp.Documents.Open(Doc_save)

Else

' no active document so create one

Set wdDoc = wdApp.Documents.Open(Doc_save)

End If

End If

' permet de récupérer le positionnement de la sélection (ici sur le graph)

Set wdRng = wdDoc.ActiveWindow.Selection.Range

' copie du graph

ActiveChart.ChartArea.Copy

'collage du graphique sans localisation précise

'wdRng.Paste

'collage du graphique avec localisation précise via un signet

wdDoc.Bookmarks("graphique").Range.PasteSpecial Placement:=wdInLine

Application.CutCopyMode = False

WordDoc.Application.ActiveDocument.Close

WordApp.Application.Quit

End Sub

/>"

Bonjour,

Pour ceux qui seraient confrontés au même problème que moi, voici la solution:

wdDoc.Bookmarks("graphique").Range.PasteSpecial Placement:=wdInLine

à remplacer par

wdDoc.Bookmarks("graphique").Range.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, Placement:=wdInLine, DisplayAsIcon:=False

Si quelqu'un peu m'envoyer un lien (sur ce forum ou ailleurs) pour que je comprenne le fonctionnement des balises pour insérer du code, je suis preneur.

Rechercher des sujets similaires à "coller word image tableau graph"