I managed to get a picture from Excel to Powerpoint via VBA. This method works perfectly fine. However, I'd like to reposition and resize the second picture.
Could you please help me out?
Sub ExceltoPP()
Dim pptPres As Presentation
Dim strPath As String
Dim strPPTX As String
Dim pptApp As Object
strPath = "D:\"
strPPTX = "Test.pptx"
Set pptApp = New PowerPoint.Application
pptCopy = strPath & strPPTX
pptApp.Presentations.Open Filename:=pptCopy, untitled:=msoTrue
Set pptPres = pptApp.ActivePresentation
Sheets("NEW").Range("Table").CopyPicture xlScreen, xlPicture
pptPres.Slides(2).Select
pptPres.Slides(2).Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
Set Graphic = GetObject(, "Powerpoint.Application")
With Graphic.ActiveWindow.Selection.ShapeRange
.Left = 0.39 * 72
.Top = 2 * 72
.Width = 5 * 72
.Height = 2 * 72
End With
Till this part it works perfectly fine. However, when I try to add the second picture, Powerpoint adds the picture, but the repositioning and resizing does not work.
Sheets("NEW").Range("A1:M14").CopyPicture xlScreen, xlPicture
pptPres.Slides(2).Select
pptPres.Slides(2).Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
Set Graphic2 = GetObject(, "Powerpoint.Application")
With Graphic2.ActiveWindow.Selection.ShapeRange
.Left = 0.39 * 72
.Top = 5 * 72
.Width = 5 * 72
.Height = 2 * 72
End With
pptPres.SaveAs strPath & Range("company") & ".pptx"
pptPres.Close
pptApp.Quit
Set pptPres = Nothing
Set pptApp = Nothing
End Sub