XL 2016 insérer un graphique dans word a partir d'excel

  • Initiateur de la discussion Initiateur de la discussion BaptisteLH
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

BaptisteLH

XLDnaute Nouveau
bonjour,

j'ai une base de données comportant des noms d'actifs, prix, des localisations d'actifs, des dates, trimestres ...
Mon objectif est de créer un diagramme circulaire présentant la localisation des actifs (en pourcentage) et d'insérer celui-ci dans un word en prenant en compte le nom de l'actif et la date saisi (dans le document word).

Ex : je rentre dans word : actif = toto et date = 25/03/2017
je souhaite que le graphique me donne la répartition géographique de l'actif toto début 2019


Merci d'avance,

Baptiste
 
Solution
Bonjour BaptisteLH, le forum,

Si l'on veut coller le graphique dans un document Word existant utiliser :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C2:D2]) Is Nothing Or [C2] = "" Or [D2] = "" Then Exit Sub
Dim doc$, titre$, co As ChartObject, Wapp As Object, Wd As Object
doc = ThisWorkbook.Path & "\Document Word.docx" 'chemin d'accès et nom du document Word
If Dir(doc) = "" Then MsgBox "'" & doc & "' introuvable !", vbExclamation: Exit Sub
titre = LCase([C2] & " " & [D2]) & "*"
For Each co In ChartObjects
    If LCase(co.Chart.ChartTitle.Text) Like titre Then
        co.Copy 'copie
        On Error Resume Next
        Set Wapp = GetObject(, "Word.Application")
        If Wapp Is Nothing Then Set Wapp =...
Bonjour,

ce n'est pas si simple, j'ai de nombreux actifs (40) et 16 périodes par actifs ... soit 640 graphiques a générer...
je souhaite donc faire un graphique ou l'utilisateur WORD donnera le nom de l'actif et la période. Ceci formera un seul graphe.

J’espère avoir été assez précis!

Merci d'avance
 
Bonjour BaptisteLH, le forum,

Puisque vous ne joignez pas de fichier adaptez celui-ci et la macro :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C2:D2]) Is Nothing Or [C2] = "" Or [D2] = "" Then Exit Sub
Dim titre$, co As ChartObject, Wapp As Object, Wd As Object
titre = LCase([C2] & " " & [D2]) & "*"
For Each co In ChartObjects
    If LCase(co.Chart.ChartTitle.Text) Like titre Then
        co.Copy 'copie
        On Error Resume Next
        Set Wapp = GetObject(, "Word.Application")
        If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
        On Error GoTo 0
        Wapp.Visible = True
        Set Wd = Wapp.Documents.Add
        Wd.ActiveWindow.Selection.Paste 'colle
        [A1].Copy [A1] 'vide le presse_papiers
        Wd.ActiveWindow.WindowState = 1 'wdWindowStateMaximize
        AppActivate "Word"
        Exit Sub
    End If
Next
MsgBox "Le graphique correspondant n'existe pas !", vbExclamation
End Sub
Le graphique est recherché et collé dans Word quand C2 et D2 sont renseignés.

A+
 

Pièces jointes

Dernière édition:
Bonjour BaptisteLH, le forum,

Si l'on veut coller le graphique dans un document Word existant utiliser :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C2:D2]) Is Nothing Or [C2] = "" Or [D2] = "" Then Exit Sub
Dim doc$, titre$, co As ChartObject, Wapp As Object, Wd As Object
doc = ThisWorkbook.Path & "\Document Word.docx" 'chemin d'accès et nom du document Word
If Dir(doc) = "" Then MsgBox "'" & doc & "' introuvable !", vbExclamation: Exit Sub
titre = LCase([C2] & " " & [D2]) & "*"
For Each co In ChartObjects
    If LCase(co.Chart.ChartTitle.Text) Like titre Then
        co.Copy 'copie
        On Error Resume Next
        Set Wapp = GetObject(, "Word.Application")
        If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
        On Error GoTo 0
        Wapp.Visible = True
        Set Wd = Wapp.Documents.Open(doc) 'ouvre le document Word
        With Wd.ActiveWindow.Selection
            .EndOf 6, 0 'Unit:=wdStory, Extend:=wdMove
            .Paste 'colle
        End With
        [A1].Copy [A1] 'vide le presse_papiers
        Wd.ActiveWindow.WindowState = 1 'wdWindowStateMaximize
        AppActivate "Word"
        Exit Sub
    End If
Next
MsgBox "Le graphique correspondant n'existe pas !", vbExclamation
End Sub
Téléchargez les fichiers joints dans le même dossier (le bureau).

A+
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Retour