Hi All,

My current macro transfers charts to specific slides based on a table of contents, but I need to modify it to send all inserted charts to the back.

Bonus, if possible have the ranges pasted using source formatting (K) rather than just a simple paste.

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 = 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
    End With
    
      
     
Next

End Sub