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
- Messages
- 4'090
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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) ?
- Messages
- 4'090
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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.