Excel Charts to Powerpoint

[iB4e]

I have this VBA that works beautifully as far as copying my two charts from Excel and placing them in a single Powerpoint slide. Except for one small thing that is driving me bonkers. The first chart resizes and is placed exactly where I want it on the slide. However, I cannot figure out how to resize the second chart and place it in right next to the first chart. Can someone please help me?

Sub Open_PowerPoint_Presentation()

'Opens a PowerPoint Document from Excel

Dim objPPT As Object
Dim activeSlide As PowerPoint.Slide
Dim cht As Excel.ChartObject

Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True

'path for the ppt

objPPT.Presentations.Open "path\powerpoint.pptx"

For Each cht In ActiveSheet.ChartObjects

objPPT.ActiveWindow.View.GotoSlide objPPT.ActivePresentation.Slides.Count
Set activeSlide = objPPT.ActivePresentation.Slides(objPPT.ActivePresentation.Slides.Count)

'Copy the chart and paste it into the PowerPoint as a picture

cht.Select
ActiveChart.ChartArea.Copy
activeSlide.Shapes.PasteSpecial(DataType:=ppPastePNG).Select

'resizing and placement of first chart

objPPT.ActiveWindow.Selection.ShapeRange.Left = 30
objPPT.ActiveWindow.Selection.ShapeRange.Top = 55

activeSlide.Shapes(1).Height = 400
activeSlide.Shapes(1).Width = 350

'resizing and placement of second chart
***this is the part that is not working***

' objPPT.ActiveWindow.Selection.ShapeRange.Left = 80
' objPPT.ActiveWindow.Selection.ShapeRange.Top = 55

' activeSlide.Shapes(2).Width = 400
' activeSlide.Shapes(2).Left = 350

Next

'more code goes here that works great

End Sub

 

[iB4e]

Never mind I got it working. Instead of using a For-Next loop I just had it copy and paste one chart at a time. I know it's not the most efficient way to do it, but at this point I just need a proof-of-concept for my boss. He will be pleased with it. Here is my update code

Sub Open_PowerPoint_Presentation2()
'Opens a PowerPoint Document from Excel
Dim objPPT As Object
Dim activeSlide As PowerPoint.Slide
Dim cht As Excel.ChartObject
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
'Change the directory path and file name to the location
'of your document
objPPT.Presentations.Open "path\powerpoint.pptx"
'chart 1
ActiveSheet.ChartObjects("Chart 3").Activate
ActiveChart.ChartArea.Copy

objPPT.ActiveWindow.View.GotoSlide objPPT.ActivePresentation.Slides.Count
Set activeSlide = objPPT.ActivePresentation.Slides(objPPT.ActivePresentation.Slides.Count)
activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
objPPT.ActiveWindow.Selection.ShapeRange.Left = 15
objPPT.ActiveWindow.Selection.ShapeRange.Top = 55
activeSlide.Shapes(1).Height = 400
activeSlide.Shapes(1).Width = 345

'chart 2

ActiveSheet.ChartObjects("Chart 5").Activate
ActiveChart.ChartArea.Copy

objPPT.ActiveWindow.View.GotoSlide objPPT.ActivePresentation.Slides.Count
Set activeSlide = objPPT.ActivePresentation.Slides(objPPT.ActivePresentation.Slides.Count)
activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select

objPPT.ActiveWindow.Selection.ShapeRange.Left = 375
objPPT.ActiveWindow.Selection.ShapeRange.Top = 55
activeSlide.Shapes(2).Height = 322
activeSlide.Shapes(2).Width = 318

'title box and notes box
ActiveSheet.Range("B33:O40").Select
Selection.Copy
activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
objPPT.ActiveWindow.Selection.ShapeRange.Left = 15
objPPT.ActiveWindow.Selection.ShapeRange.Top = 340

ActiveSheet.Range("B43:O43").Select
Selection.Copy
activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
objPPT.ActiveWindow.Selection.ShapeRange.Left = 15
objPPT.ActiveWindow.Selection.ShapeRange.Top = 10

End Sub