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

souf12

New Member
Joined
Aug 20, 2020
Messages
4
Office Version
  1. 2016
Platform
  1. Windows
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?

VBA Code:
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
 

Some videos you may like

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
Welcome to MrExcel :)

Try this
VBA Code:
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

New Member
Joined
Aug 20, 2020
Messages
4
Office Version
  1. 2016
Platform
  1. Windows
Welcome to MrExcel :)

Try this
VBA Code:
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!
 

Watch MrExcel Video

Forum statistics

Threads
1,126,992
Messages
5,622,033
Members
415,874
Latest member
JockPC

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top