工作自动化pptx，通过VBA生成.从Excel复制一系列单元格并粘贴到PPT相当简单的过程.有一个主要的子（）循环遍历一个列表，启动第二个子元素（）。问题似乎在下面的子目录中的某个地方（“第二个子”），因为PPT打印，但对象位置仅在幻灯片组中的最后一张幻灯片上是正确的。或者根本没有应用？任何帮助都将不胜感激。

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

我也试过在循环后添加一个位置修正sub（）（以防是循环导致的），但由于某种原因，它仍然没有将格式应用到每张幻灯片。似乎只添加到当前幻灯片或当前幻灯片和之前的一张幻灯片。

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

更新：
单步执行代码后，如果正在构建的幻灯片不是视图中当前选定的幻灯片，则形状格式/结构不会应用。不确定如何解决。