Excel VBA复制单元格到PPT：仅最后一页形状位置正确问题

我通过Excel VBA循环调用AddSlideToOpenPowerPoint()，将Excel单元格区域复制到打开的PowerPoint演示文稿中，为每条记录生成幻灯片。但打印时发现只有最后一页的对象位置是正确的，其余幻灯片的对象位置都不对。调试后发现，若构建幻灯片时未处于当前选中视图，形状的格式/结构无法正常应用。

原AddSlideToOpenPowerPoint()代码 #

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

尝试的Position()修正代码 #

我尝试在循环后调用以下子过程修正位置，但仅当前或前一页生效：

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

内容的提问来源于stack exchange，提问作者2020db9