VBA代码用于在PowerPoint中导出Excel范围和格式形状

我正在使用Excel VBA代码来格式化Powerpoint幻灯片，如下所示。 我需要帮助通过我的代码格式化每个单独的幻灯片形状。 目前我的VBA代码复制了一系列数据并将其粘贴到Powerpoint中。

Sub PasteMultipleSlides() Dim myPresentation As Object Dim mySlide As Object Dim PowerPointApp As Object Dim shp As Object Dim MySlideArray As Variant Dim MyRangeArray As Variant Dim x As Long 'create a new non contagiuos range Dim newRng As Range Set range1 = Sheets("Sheet1").Range("$A$6:$I$8") Set range2 = Sheets("Sheet1").Range("$A$17:$I$33") Set newRng = Union(range1, range2) 'Create an Instance of PowerPoint On Error Resume Next 'Is PowerPoint already opened? Set PowerPointApp = GetObject(class:="PowerPoint.Application") 'Clear the error between errors Err.Clear 'If PowerPoint is not already open then Exit If PowerPointApp Is Nothing Then MsgBox "PowerPoint Presentation is not open, aborting." Exit Sub End If 'Handle if the PowerPoint Application is not found If Err.Number = 429 Then MsgBox "PowerPoint could not be found, aborting." Exit Sub End If On Error GoTo 0 'Make PowerPoint Visible and Active PowerPointApp.ActiveWindow.Panes(2).Activate 'Create a New Presentation Set myPresentation = PowerPointApp.ActivePresentation 'List of PPT Slides to Paste to MySlideArray = Array(2, 3, 4, 5, 6) 'List of Excel Ranges to Copy from MyRangeArray = Array(Sheet1.Range("$A$6:$I$16"), Sheet1.Range("$A$6:$I$8,$A$17:$I$33"), _ Sheet1.Range("$A$6:$I$16"), Sheet1.Range("$A$6:$I$16"), Sheet1.Range("$A$6:$I$16")) 'Loop through Array data For x = LBound(MySlideArray) To UBound(MySlideArray) 'Copy Excel Range With MyRangeArray(x) 'hide all rows .Parent.Rows.Hidden = True 'show range's rows .EntireRow.Hidden = False .Copy 'Paste to PowerPoint and position On Error Resume Next Set shp = myPresentation.Slides(MySlideArray(x)).Shapes.PasteSpecial(DataType:=2) 'Excel 2007-2010 Set shp = PowerPointApp.ActiveWindow.Selection.ShapeRange 'Excel 2013 On Error GoTo 0 'show back all rows .Parent.Rows.Hidden = False End With 'Center Object With myPresentation.PageSetup shp.Left = (.SlideWidth \ 2) - (shp.Width \ 2) shp.Top = (.SlideHeight \ 2) - (shp.Height \ 2) End With Next x 'Transfer Complete Application.CutCopyMode = False ThisWorkbook.Activate MsgBox "Complete!" End Sub 

问题在于，所有幻灯片的尺寸都与第一张相同。 我如何格式化每个形状的大小？