Modify macro to look at active powerpoint

[scruz9]

Hi All,

I have a workbook that is shared by other users, so rather than having the file path follow my local I'd like to just modify it to look at whatever the active PowerPoint presentation is. Please see my code below:

Option Explicit

Sub MakePowerpoint()
Dim MyPath As String
Dim FileName As String

Dim objPPT As Object
Dim ppt As Object
Dim sld As Object
Dim shp As Object
Dim PPName As String
Dim shpIndex As Long
Dim CurSlide As Long

Dim sh As Excel.Worksheet
Dim ObjName As String
Dim ObjType As String
Dim PPSldNum As Long
Dim PPObjName As Long
Dim MyTop As Double
Dim MyLeft As Double
Dim MyHeight As Double
Dim MyWidth As Double
Dim cl As Range


MyPath = ThisWorkbook.Path
PPName = "CURRENT LOCAL FILE PATH"

' Open the PowerPoint Presentation
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
objPPT.presentations.Open PPName

Set ppt = objPPT.ActivePresentation
Set sld = ppt.slides(1)

' Add objects
For Each cl In Range("Table_Objects[Excel Page]")
    Set sh = Sheets(cl.Value)           ' Excel Sheet
    ObjName = cl.Offset(0, 1).Value     ' Name of the thing to copy
    ObjType = cl.Offset(0, 2).Value     ' Type of the thing to copy
    PPSldNum = cl.Offset(0, 3).Value    ' PowerPoint slide number
    MyTop = cl.Offset(0, 5).Value       ' Top
    MyLeft = cl.Offset(0, 6).Value      ' Left
    MyHeight = cl.Offset(0, 7).Value    ' Height
    MyWidth = cl.Offset(0, 8).Value     ' Width
    
    Set sld = ppt.slides(PPSldNum)      ' Active Slide
    If ObjType = "Chart" Then
        sh.Shapes(ObjName).Copy
    Else
        sh.Range(ObjName).CopyPicture
        
    End If
    sld.Shapes.Paste

    shpIndex = sld.Shapes.Count
    With sld.Shapes(shpIndex)
        .LockAspectRatio = msoFalse
        .Top = 72 * MyTop
        .Left = 72 * MyLeft
        .Height = 72 * MyHeight
        .Width = 72 * MyWidth
        .ZOrder msoSendToBack
    End With
    
      
     
Next

End Sub

[xlnitwit]

Hi,

You can use Getobject rather than CreateObject.

Set objPPT = GetObject(, "PowerPoint.Application")