Replacing an Existing Graph in PowerPoint with A New Graph From Excel (Positioning) VBA

[souf12]

Hello,

I'm trying to write a VBA code to replace an old graph in PowerPoint with a new graph from Excel. I can currently export the graph to the PowerPoint file but I cannot get the positioning right.

I've tried using the functions .Top, .Height, .Width etc. but this doesn't put the graph where I want it.

Since I cannot get the positioning right using the functions mentioned above, I'm wondering if there is a way I can measure the position and dimensions of the old graph and then paste the Excel graph using the position and dimensions. Is this possible to do?

Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object


Worksheets("Sheet1").Activate

ActiveSheet.ChartObjects("Graph1").Chart.CopyPicture



If PowerPointApp Is Nothing Then _
Set PowerPointApp = CreateObject(class:="PowerPoint.Application")


Application.ScreenUpdating = False

Set myPresentation = PowerPointApp.Presentations.Open(Filename:="C:\x\xy\xyz\x\xx.pptx")

Set mySlide = myPresentation.Slides(4)
ActiveChart.ChartArea.Copy

mySlide.Shapes.Paste
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)




    ' Position pasted chart
With myShape
   .Top = x
   .Height = x
   .Width = x
   .ZOrder (msoSendToBack)


PowerPointApp.Visible = True
PowerPointApp.Activate

Application.CutCopyMode = False

End Sub

 

[Yongle]

Welcome to MrExcel

Try this

Sub CopyChartToPowerpoint()
    Dim rng As Range
    Dim PowerPointApp As Object
    Dim myPresentation As Object
    Dim mySlide As Object
    Dim myShape As Object
'open powerpoint presentation
    On Error Resume Next
    Set PowerPointApp = GetObject(class:="PowerPoint.Application")
    If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
    On Error GoTo 0
    Application.ScreenUpdating = False
    Set myPresentation = PowerPointApp.Presentations.Open(Filename:="C:\??????????\pp1.pptx")
    Set mySlide = myPresentation.Slides(4)
'copy chart from Excel and paste to powerpoint
    ThisWorkbook.Worksheets("Sheet1").ChartObjects("Graph1").Chart.CopyPicture
    mySlide.Shapes.Paste
    Application.CutCopyMode = False
'chart position
    Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
    With myShape
        .Left = 75
        .Top = 25
        .Width = 1000
        .Height = 250
    End With
'activate powerpoint
  PowerPointApp.Visible = True
  PowerPointApp.Activate
End Sub

 

[souf12]

Welcome to MrExcel

Try this

Sub CopyChartToPowerpoint()
    Dim rng As Range
    Dim PowerPointApp As Object
    Dim myPresentation As Object
    Dim mySlide As Object
    Dim myShape As Object
'open powerpoint presentation
    On Error Resume Next
    Set PowerPointApp = GetObject(class:="PowerPoint.Application")
    If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
    On Error GoTo 0
    Application.ScreenUpdating = False
    Set myPresentation = PowerPointApp.Presentations.Open(Filename:="C:\??????????\pp1.pptx")
    Set mySlide = myPresentation.Slides(4)
'copy chart from Excel and paste to powerpoint
    ThisWorkbook.Worksheets("Sheet1").ChartObjects("Graph1").Chart.CopyPicture
    mySlide.Shapes.Paste
    Application.CutCopyMode = False
'chart position
    Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
    With myShape
        .Left = 75
        .Top = 25
        .Width = 1000
        .Height = 250
    End With
'activate powerpoint
  PowerPointApp.Visible = True
  PowerPointApp.Activate
End Sub

Perfect! Thank you!