Ouvrir un fichier Excel + Copier Graphique - collage avec liens

**Duetor** · 10/08/2016, 16h56

Bonjour ,
Débutant en VBA et actuellement en stage je cherche à réaliser une macro que effectuera les taches suivantes :
- Ouvrir un fichier Excel depuis mon PowerPoint
- Copier les graphiques dans ma slide
- Fermer mon fichier Excel
NB : Je n'ai pas le droit d'utiliser les collages avec liens sinon ce serai trop facile bien sur

Après plusieurs recherche sur différent forum j'ai réaliser le patchwork de programme suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
 
Sub Slide4_Click()
   Dim Cht As Excel.ChartObject
   Dim appExcel As Excel.Application 'Application Excel
   Dim wbExcel As Excel.Workbook 'Classeur Excel
   Dim wsExcel As Excel.Worksheet 'Feuille Excel
   Dim wsExcel2 As Excel.Worksheet 'Feuille Excel
    'Ouverture de l'application
    Set appExcel = CreateObject("Excel.Application")
   'Ouverture d'un fichier Excel
   Set wbExcel = appExcel.Workbooks.Open("chemin fichier")
    'wsExcel correspond à la première feuille du fichier
    Set wsExcel = wbExcel.Worksheets("nom feuille1")
    wsExcel.Activate
    'Pour chaque objet dnas ma feuille
    For Each Cht In wsExcel.ChartObjects
           Cht.Select
           Selection.Copy
           ActivePresentation.Slides(4).Select '4 étant le numero de ma slide 
           ActivePresentation.Slides(4).Shapes.Paste
          wsExcel.Activate
   Next Cht
   Set wsExcel2 = wbExcel.Worksheets("Nom feuille 2")
   wsExcel2.Activate
    For Each Cht In wsExcel.ChartObjects
          Cht.Select
          Selection.Copy
          ActivePresentation.Slides(4).Select
          ActivePresentation.Slides(4).Shapes.Paste
          wsExcel2.Activate
   Next Cht
   wbExcel.Close
End Sub

Le programme s’exécute mais persiste plusieurs Bug :
-> lors de la recherche de graphique sur ma deuxième feuilles il identifie bien qu'il y a 2 élément graphique mais il me copie 2 fois le première élément sélectionné
-> De temps a autre le cht.select refuse d’être identifier alors qu'il y a bien des élément graphique sur ma feuille Excel

En l'attente d'un miracle,

Cordialement David

**Duetor** · 11/08/2016, 10h44

J'ai contourné le problème en appelant directement mes graphique par leurs noms et en changent l'appel de mon fichier.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub Slide4_Click()
    Dim FichierA As String
    Dim wka As Excel.Workbook
    Dim Cht As ChartObject
    FichierA = "nom du fichier"
    Workbooks.Open FileName:="adresse du fichier"
    Set wka = Workbooks(FichierA)
    wka.Sheets("nom de ma feuille").Activate
    ActiveSheet.ChartObjects("Graphique 1").Activate
    Selection.Copy
    ActivePresentation.Slides(4).Select
    ActivePresentation.Slides(4).Shapes.PasteSpecial DataType:=ppPasteDefault
    wka.Sheets("nom de ma feuille2").Activate
    ActiveSheet.ChartObjects("Graphique 1").Activate
    Selection.Copy
    ActivePresentation.Slides(4).Select
    ActivePresentation.Slides(4).Shapes.PasteSpecial DataType:=ppPasteDefault
    wka.Sheets("nom de ma feuille2").Activate
    ActiveSheet.ChartObjects("Graphique 2").Activate
    Selection.Copy
    ActivePresentation.Slides(4).Select
    ActivePresentation.Slides(4).Shapes.PasteSpecial DataType:=ppPasteDefault
    wka.Close
End Sub