Specify shape position on each slide

Question

I copy a range of cells from Excel to a PowerPoint presentation.

There is a main sub() that loops through a list, kicking off Sub AddSlideToOpenPowerPoint() for each record on the list.

The issue appears to be in AddSlideToOpenPowerPoint as the presentation prints but the object position is only correct on the last slide in the deck.

Sub AddSlideToOpenPowerPoint()

Dim Rng As Range
Dim Tables As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object
Dim oPPShape As Object

'Copy Range from Excel
  Set Rng = ThisWorkbook.Sheets(1).Range("D6:V24")

'Optimize Code
  Application.ScreenUpdating = False

'Navigate to open PPT
  Set PowerPointApp = GetObject(, "PowerPoint.Application")
  PowerPointApp.Visible = True
  Set myPresentation = PowerPointApp.ActivePresentation
  
'Add a slide to the Presentation
  Set mySlide = myPresentation.Slides.Add(1, 16) '11 = ppLayoutTitleOnly

'Copy Excel Range
  Rng.Copy

'Paste to PowerPoint and position
  mySlide.Shapes.PasteSpecial DataType:=0  '0 = ppPasteDefault - if image = 2
  Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
  
    'Set position:
      myShape.Left = 18
      myShape.Top = 170

'Add slide title based on current segment:
    
    'Selects title shape
    Set oPPShape = mySlide.Shapes(1)
    
    'Selects cell range to copy into shape(1)
    oPPShape.TextFrame.TextRange.Text = _
    ThisWorkbook.Sheets(1).Range("B1").Value
    
'Add gray text boxes from excel template
    Set Tables = ThisWorkbook.Sheets(1).Range("D2:V4")
    Tables.Copy
    mySlide.Shapes.PasteSpecial DataType:=0
    
    'Reposition shape
    Set TableShape = mySlide.Shapes(3)
    TableShape.Top = 110
    TableShape.Left = 18
    
'Make PowerPoint Visible and Active
  PowerPointApp.Visible = True
  PowerPointApp.Activate

'Apply template theme (this may need to be saved to shared drive)
  myPresentation.ApplyTemplate "\\BaseTemplate.potx"

'Clear The Clipboard
  Application.CutCopyMode = False
  
End Sub

I tried adding a position correction sub() after the loop (in case it was the loop causing it). It's still not applying the formatting to every slide. Only adding to the current slide or the current and one prior.

Sub Position()
    Dim PowerPointApp As PowerPoint.Application
    Set PowerPointApp = GetObject(, "PowerPoint.Application")
    PowerPointApp.Visible = True
    Set myPresentation = PowerPointApp.ActivePresentation
    Dim slide As slide
    
    For Each slide In myPresentation.Slides
        slide.Shapes(3).Top = 170
        slide.Shapes(3).Left = 18
        slide.Shapes(1).Top = 110
        slide.Shapes(1).Left = 18
    Next
    
End Sub

After stepping through the code, if the slide being constructed isn't the one currently selected in view, the shape format/structure is not applied.

Answer 1

by adding:

myPresentation.Slides(1).Select

after the step that generates a new slide, this allowed for correct object positioning. I guess this is a vba limitation that I wasn't aware of. Would also require the PPT to be visible during construction, which is another limitation.