Coller un Graphique Excel dans Powerpoint à l'aide de VBA

Je suis en train de créer une macro excel qui copie les graphiques affichés sur une feuille excel, et les colle (collage spécial) dans une présentation PowerPoint. Le problème que je vais avoir est de savoir comment dois-je coller chaque graphique sur une autre diapositive? Je ne connais pas la syntaxe à tous..

C'est ce que j'ai jusqu'à présent (il fonctionne mais il ne colle à la première feuille):

Sub graphics3()

Sheets("Chart1").Select
ActiveSheet.ChartObjects("Chart1").Activate
ActiveChart.ChartArea.Copy
Sheets("Graphs").Select
range("A1").Select
ActiveSheet.Paste
     With ActiveChart.Parent
     .Height = 425 ' resize
     .Width = 645  ' resize
     .Top = 1    ' reposition
     .Left = 1   ' reposition
 End With

Dim PPT As Object
Set PPT = CreateObject("PowerPoint.Application")
PPT.Visible = True
PPT.Presentations.Open Filename:="locationwherepptxis"

Set PPApp = GetObject("Powerpoint.Application")
Set PPPres = PPApp.activepresentation
Set PPSlide = PPPres.slides _
    (PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)

' Copy chart as a picture
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, _
    Format:=xlPicture

' Paste chart
PPSlide.Shapes.Paste.Select

' Align pasted chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

OriginalL'auteur thedeepfield | 2011-09-20

  1. 7

    Donné je n'ai pas vos emplacements des fichiers pour travailler avec, j'ai joint une routine ci-dessous que

    1. Créé une nouvelle instance de PowerPoint (liaison tardive, d'où la nécessité de définir des constantes pour ppViewSlide etc)
    2. Parcourt chaque graphique dans une feuille appelée Chart1 (comme par votre exemple)
    3. Ajoute une nouvelle diapositive
    4. Colle chaque graphique, puis répète

    Avez-vous besoin de formater chaque graphique de l'image avant de l'exporter pour la taille, ou pouvez-vous modifier votre taille par défaut des graphiques?

    Const ppLayoutBlank = 2
Const ppViewSlide = 1

Sub ExportChartstoPowerPoint()
    Dim PPApp As Object
    Dim chr
    Set PPApp = CreateObject("PowerPoint.Application")
    PPApp.Presentations.Add
    PPApp.ActiveWindow.ViewType = ppViewSlide
    For Each chr In Sheets("Chart1").ChartObjects
        PPApp.ActivePresentation.Slides.Add PPApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank
        PPApp.ActiveWindow.View.GotoSlide PPApp.ActivePresentation.Slides.Count
        chr.Select
        ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        PPApp.ActiveWindow.View.Paste
        PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
        PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
    Next chr
    PPApp.Visible = True
End Sub
    +1, Mais pourquoi ne pas la liaison anticipée?
    Merci Jean-François. C'est une bonne question - la réponse la plus courte est de préférence personnelle. Généralement je vais la fin de bind si plusieurs versions de l'objet étant automatisée, sont possibles, et que j'ai trouvé les utilisateurs dans le Q&les forums peuvent avoir des difficultés avec réglage de référence. Alors que j'ai utilisé au début binging dans mon Double Master complément comme il ne lie que le fichier de bibliothèque de scripts, il rase de 20 à 30% de réduction d'exécution et dans le cadre de l'addin il est installé automatiquement pour les utilisateurs.

    OriginalL'auteur brettdj

  2. 2

    Code avec la fonction pour tracer les 6 cartes à partir d'Excel, PPT 

    Option Base 1
Public ppApp As PowerPoint.Application
Sub CopyChart()
Dim wb As Workbook, ws As Worksheet
Dim oPPTPres As PowerPoint.Presentation
Dim myPPT As String
myPPT = "C:\LearnPPT\MyPresentation2.pptx"
Set ppApp = CreateObject("PowerPoint.Application")
'Set oPPTPres = ppApp.Presentations("MyPresentation2.pptx")
Set oPPTPres = ppApp.Presentations.Open(Filename:=myPPT)
ppApp.Visible = True
Set wb = ThisWorkbook
Set ws = wb.Sheets(1)
i = 1
For Each shp In ws.Shapes
strShapename = "C" & i
ws.Shapes(shp.Name).Name = strShapename
'shpArray.Add (shp)
i = i + 1
Next shp
Call Plot6Chart(oPPTPres, 2, ws.Shapes(1), ws.Shapes(2), ws.Shapes(3), ws.Shapes(4), ws.Shapes(5), ws.Shapes(6))
End Sub
Function Plot6Chart(pPres As Presentation, SlideNo As Long, ParamArray cCharts())
Dim oSh As Shape
Dim pSlide As Slide
Dim lLeft As Long, lTop As Long
Application.CutCopyMode = False
Set pSlide = pPres.Slides(SlideNo)
For i = 0 To UBound(cCharts)
cCharts(i).Copy
ppApp.ActiveWindow.View.GotoSlide SlideNo
pSlide.Shapes.Paste
Application.CutCopyMode = False
If i = 0 Then ' 1st Chart
lTop = 0
lLeft = 0
ElseIf i = 1 Then ' 2ndChart
lLeft = lLeft + 240
ElseIf i = 2 Then ' 3rd Chart
lLeft = lLeft + 240
ElseIf i = 3 Then ' 4th Chart
lTop = lTop + 270
lLeft = 0
ElseIf i = 4 Then ' 5th Chart
lLeft = lLeft + 240
ElseIf i = 5 Then ' 6th Chart
lLeft = lLeft + 240
End If
pSlide.Shapes(cCharts(i).Name).Left = lLeft
pSlide.Shapes(cCharts(i).Name).Top = lTop
Next i
Set oSh = Nothing
Set pSlide = Nothing
Set oPPTPres = Nothing
Set ppApp = Nothing
Set pPres = Nothing
End Function

    OriginalL'auteur Vinayak K