指定每张幻灯片上的形状位置

Question

我将一系列单元格从 Excel 复制到 PowerPoint 演示文稿。

有一个 main sub() 循环遍历列表，为列表中的每条记录启动

Sub AddSlideToOpenPowerPoint()

。

打印演示文稿时，问题似乎出现在

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

我尝试在循环后添加位置校正 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

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

Answer 1

添加：

myPresentation.Slides(1).Select

在生成新幻灯片的步骤之后，这可以实现正确的对象定位。我想这是我没有意识到的 vba 限制。还要求 PPT 在构建过程中可见，这是另一个限制。