XL 2013 macro copie de graphique excel dans doc word

[ciocciu]

bonjour
j'ai une petite macro qui me copie /colle des graphiques dans un doc word...Sauf que j'ai une erreur sur la ligne 14 pour aller se positionner dans word au niveau du signet ..... l'erreur me dit " ce signet n'existe pas " alors que bien sur il existe dans word
Vous auriez une idée de ce qu'il se passe ?
merci beaucoup

Dim ws As Worksheet
Dim i As Integer

Application.ScreenUpdating = False

Set ws = ThisWorkbook.Sheets("Evolution annuelle") 'Onglet contenant les graphiques

' - On suppose que le fichier Word est déjà ouvert
Set wrdApp = GetObject(, "Word.Application") 'Word déjà ouvert
Set wrdDoc = wrdApp.ActiveDocument

' -- Copier le 1er Graphique nommé "Graphique 2"
ActiveSheet.ChartObjects("Graphique 2").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto what:=wdGoToBookmark, Name:="rep" ' on recherche le signet dans Word pour se positionner
'wrdApp.Selection.MoveLeft wdCharacter, 1 ' optionnel : pour se placer AVANT le signet (move left)
wrdApp.Selection.PasteSpecial link:=False, DataType:=wdpastemetafilepicture, Placement:=wdinline, displayasicon:=False

' -- Terminer
wrdDoc.Save
Set wrdDoc = Nothing: Set wrdApp = Nothing
Application.ScreenUpdating = True

End Sub

 

[Gégé-45550]

Bonjour,
Essayez comme ceci :

Dim wrdApp As Word.Application
Dim wrdDoc As Word.document, templateDoc As Word.document
Dim NomDocument As String, sPath As String, WDoc As String

'on ouvre Word pour commencer
   Set wrdApp = CreateObject("Word.Application")   'on crée un nouvel objet Word

sPath = "le chemin du fichier Word qui va bien"
NomDocument = "le nom du fichier Word de destination"
WDoc = sPath & NomDocument

 'Word est ouvert
         'on boucle sur tous les documents ouverts et on regarde si NomDocument existe déjà
         For i = 1 To wrdApp.Documents.Count
            If wrdApp.Documents(i).Name = NomDocument Then
               Set wrdDoc = wrdApp.Documents(i)
               Exit For
            End If
         Next i

 If wrdDoc Is Nothing Then   'le document n'est pas ouvert
            'on ouvre le fichier gabarit et on le renomme (le fichier gabarit n'est plus ouvert ensuite)
    Set templateDoc = wrdApp.Documents.Open(sPath & "le nom et l'extension du fichier Word gabarit")   'on ouvre le template
                Set wrdDoc = templateDoc
                wrdDoc.SaveAs (WDoc)   'renomme le gabarit
End if

  'ON FAIT LES MODIFICATIONS DU FICHIER WORD
        
         'On se positionne au bon endroit dans le fichier Word
         wrdApp.Windows(wrdDoc).Activate   'il faut d'abord activer la bonne fenêtre (car s'il y en a plusieurs, ça va écrire dans la dernière active)

         ' -- Copier le 1er Graphique nommé "Graphique 2"
         ActiveSheet.ChartObjects("Graphique 2").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
         wrdApp.Selection.Goto what:=wdGoToBookmark, Name:="rep" ' on recherche le signet dans Word pour se positionner
         With wrdApp.Selection
           'on fait ce qu'on a à faire
           .PasteSpecial link:=False, DataType:=wdpastemetafilepicture, Placement:=wdinline, displayasicon:=False
           .../...
         End With
'Terminer
.../...

Bonne fête du Travail