Export multiple Ranges/Charts to PowerPoint

[abc_xyz]

Overview: I am trying to create a dashboard wherein the user can provide information to copy from the given file name, sheet name and range/chart name. Also, the ability to paste the Range/Charts as Image or Table or Chart Object can be selected from the dashboard itself and paste them into the active presentation. The idea is to give a unique name to the range/chart and paste it into the active presentation and resize and reposition it.

Error: The below code seems to work properly if pasted as just image but fails when instructed to paste as Table/Chart. The active presentation already has some shapes and images in them and the code resizes and repositions any random shape in that slide.

Preview of the Dashboard

File Path/Name	Sheet Name	Data Range\Chart Name	Identifier	Slide No.	Height	Width	Horizontal Pos	Vertical Pos	Units
		Chart 1	Chart as Chart	2	7.01	9.53	15.24	9.53	CM
		W56:AL69	Rng as Table	2	2.66	6.2	0.17	0.59	Inch
		Chart 6	Chart as Img	2	8.67	12.53	0.64	8.7	CM

Can someone please help me with the issue?

Sub WithImgName()
    
Dim OpenBook_path As String, UniqueName As String, OpenBook_Sheet As String, OpenBook_Range As String, Units As String, Identifier As String, Available_File As String, Next_File As String
Dim FileToOpen As Workbook
Dim i As Long, Lastrow As Long
Dim StartTime As Double
Dim MinutesElapsed As String
Dim Shp As Shape
Dim xshp As Shapes

StartTime = Timer


With Application
   .ScreenUpdating = False
   .DisplayAlerts = False
   .EnableEvents = False
End With
    
    
    
    
'pptTemplate = ThisWorkbook.Sheets("Dashboard").Range("F3").Value

Set PPT = GetObject(Class:="Powerpoint.Application")

'PPT.Presentations.Open Filename:=pptTemplate
    
    
    
    
Lastrow = ThisWorkbook.Sheets("Dashboard").Range("F" & Rows.Count).End(xlUp).Row
    
For i = 9 To Lastrow
        
        OpenBook_path = ThisWorkbook.Sheets("Dashboard").Cells(i, 6)  'Path includes file name with extension
        OpenBook_Sheet = ThisWorkbook.Sheets("Dashboard").Cells(i, 7)
        OpenBook_Range = ThisWorkbook.Sheets("Dashboard").Cells(i, 8)
        Identifier = ThisWorkbook.Sheets("Dashboard").Cells(i, 9)
        
        
        Slide_No = ThisWorkbook.Sheets("Dashboard").Cells(i, 10)
        Img_Height = ThisWorkbook.Sheets("Dashboard").Cells(i, 11)
        Img_Width = ThisWorkbook.Sheets("Dashboard").Cells(i, 12)
        Img_Horizontal_Pos = ThisWorkbook.Sheets("Dashboard").Cells(i, 13)
        Img_Vetical_Pos = ThisWorkbook.Sheets("Dashboard").Cells(i, 14)
        Units = ThisWorkbook.Sheets("Dashboard").Cells(i, 15)
        UniqueName = "HM_" & i
        
'Check if file is open,if open, then use open file; if not, open file from the path in the cell
        Available_File = Dir(OpenBook_path) 'extracts the file name from the path
        
        Set FileToOpen = Nothing
        If Not wbOpen(Available_File, FileToOpen) Then
            Set FileToOpen = Workbooks.Open(OpenBook_path, False)
        End If
        
        
        
'open workbook from the path in the cell
        With FileToOpen
        
            If Identifier = "Rng as Img" Then
'Copy range from the sheet as image----------------------------------------------------------------------------------
                    With Worksheets(OpenBook_Sheet).Range(OpenBook_Range)
                        .Name = UniqueName
                        .CopyPicture Appearance:=xlScreen, Format:=xlPicture
                    End With
            Else
                   If Identifier = "Chart as Img" Then
'Copy chart from the sheet as image----------------------------------------------------------------------------------
                            With Worksheets(OpenBook_Sheet).ChartObjects(OpenBook_Range)
                                .Name = UniqueName
                                .CopyPicture Appearance:=xlScreen, Format:=xlPicture
                            End With
                    Else
                           
                           If Identifier = "Rng as Table" Then
'Copy Range from the sheet as Table----------------------------------------------------------------------------------
                                    With Worksheets(OpenBook_Sheet).Range(OpenBook_Range)
                                        .Name = UniqueName
                                        .Copy
                                    End With
                            Else
 'Copy Range from the sheet as Table----------------------------------------------------------------------------------
                                    With Worksheets(OpenBook_Sheet).ChartObjects(OpenBook_Range)
                                        .Name = UniqueName
                                        .Copy
                                    End With
                            End If
                    End If
            End If
        End With

                     
            
        
        
   
        
'Paste Excel range in slide with dimensions
            With PPT.ActivePresentation.Slides(Slide_No)
    
    
    
                If Identifier = "Rng as Table" Or Identifier = "Chart as Chart" Then
                        Application.Wait Now + #12:00:01 AM#
                        PPT.CommandBars.ExecuteMso "PasteSourceFormatting"
                Else
                        Application.Wait Now + #12:00:01 AM#
                        .Shapes.PasteSpecial
                End If
  
  
                    
                    If Units = "CM" Then
                            With .Shapes(.Shapes.Count)
                                 .LockAspectRatio = msoFalse
                                 .Height = Img_Height * 28.3465
                                 .Width = Img_Width * 28.3465
                                 .Left = Img_Horizontal_Pos * 28.3465
                                 .Top = Img_Vetical_Pos * 28.3465
                            End With
                    Else
                            With .Shapes(.Shapes.Count)
                                 .LockAspectRatio = msoFalse
                                 .Height = Img_Height * 72
                                 .Width = Img_Width * 72
                                 .Left = Img_Horizontal_Pos * 72
                                 .Top = Img_Vetical_Pos * 72
                            End With
                    End If
            End With
        
              
        
 'Check if Below File Path & Name are same
        Next_File = ThisWorkbook.Sheets("Dashboard").Cells(i + 1, 6) 'extracts the file name from the path
        If Trim(Next_File) = "" Then
            Exit For
        Else
            If OpenBook_path = Next_File Then
                
            Else
                On Error Resume Next
                FileToOpen.Activate
                FileToOpen.Close False
                Set FileToOpen = Nothing
                On Error GoTo 0
            End If
        End If
Next i
    On Error Resume Next
    FileToOpen.Close False
    
    
    ThisWorkbook.Sheets("Dashboard").Activate
    
    
With Application
   .ScreenUpdating = True
   .DisplayAlerts = True
   .EnableEvents = True
End With
    
    
    Successful_Msg
    PPT.Visible = True
    
    
'Determine how many seconds code took to run
  MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")

'Notify user in seconds
  MsgBox "This code ran successfully in " & MinutesElapsed & " minutes", vbInformation
    
    
    
End Sub



Function wbOpen(wbName As String, wbO As Workbook) As Boolean
    On Error Resume Next
    Set wbO = Workbooks(wbName)
    wbOpen = Not wbO Is Nothing
End Function

 

[abc_xyz]

Can anyone please help?