Quantcast
Channel: Active questions tagged excel - Stack Overflow
Viewing all articles
Browse latest Browse all 88886

How do I resize a second picture with VBA in Powerpoint?

$
0
0

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

Viewing all articles
Browse latest Browse all 88886


<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>