title: VBA Code For Export Excel Range and Format shapes in PowerPoint
body: <p>I am using an array to format Powerpoint slides using Excel VBA code as shown below. I need help formatting each individual slide shape via my code. Currently my VBA code copies a range of data and pastes it into Powerpoint.</p>
  
  <pre><code> 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
  </code></pre>
  
  <p>The issue is that the size for all the slides are coming out the same size as the first. How do I format the sizes of each shape?</p>