Thread: [Solved] Paste shape from Excel
View Single Post
 
Old 03-05-2020, 05:00 PM
jeffreybrown jeffreybrown is offline Windows 10 Office 2016
Expert
 
Join Date: Apr 2016
Posts: 613
jeffreybrown has a spectacular aura aboutjeffreybrown has a spectacular aura about
Default

Hi John,

I'm running the code from Excel. This seems to size the shape okay, but most likely a better way to fill the ppt slide.

Code:
Sub Chart_Module()
    Dim PPPres      As Object
    Dim PPApp       As Object
    Dim PPSlide     As Object
    Dim SlideCount  As Long
    Dim strFile     As String: strFile = "Charts.pptx"

    On Error Resume Next
    Set PPApp = GetObject(Class:="PowerPoint.Application")
    If PPApp Is Nothing Then
        Set PPApp = CreateObject(Class:="PowerPoint.Application")
    Else
        Set PPPres = PPApp.Presentations(strFile)
    End If
    On Error GoTo 0

    If PPPres Is Nothing Then
        Set PPPres = PPApp.Presentations.Open(ActiveWorkbook.Path & Application.PathSeparator & strFile)
    Else
    End If

    PPApp.ActiveWindow.ViewType = 1

    ActiveSheet.Shapes(3).Copy
    SlideCount = PPPres.Slides.Count
    Set PPSlide = PPPres.Slides.Add(SlideCount + 1, 11)
    PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex
    
    With PPSlide
        .Shapes.Paste.Select
        With .Shapes(.Shapes.Count)
            .LockAspectRatio = msoTrue
            .Left = 15
            .Top = 100
            .Height = 400
        End With
        With .Shapes(.Shapes.Count)
            .LockAspectRatio = msoFalse
            .Width = 690
        End With
    End With

End Sub
Reply With Quote