添加到 VBA (Powerpoint) 的图片被插入到占位符中

Question

我有一个 Powerpoint 2010 宏，可以将特定图片插入活动幻灯片的固定位置。

Dim oSlide As Slide
Dim oPicture As Shape

' Set oSlide to the active slide.
Set oSlide = Application.ActiveWindow.View.Slide

' Insert Image to Footer
 Set oPicture = oSlide.Shapes.AddPicture("PathToFile.png", _
  msoFalse, msoTrue, 630, 390, 15, 15)

' Move the picture to the center of the slide. Select it.
With ActivePresentation.PageSetup
  oPicture.Select
  oPicture.Name = "Dokumentverknüpfung"
End With

如果幻灯片上没有未使用的占位符，此代码可以正常工作。如果有占位符，图片会自动插入到该占位符中。

有没有办法告诉脚本避免占位符而只接受给定的坐标？

谢谢，詹斯

Answer 1

无法明确告诉 PowerPoint 不要使用图片填充空占位符，但您可以通过确保没有空占位符来阻止它这样做。如果您在插入图片之前和之后调用子 ProtectEmptyPlaceholders，则图片将作为新形状插入。

Sub InsertPicture()
  Dim oSlide As Slide
  Dim oPicture As Shape

  ' Set oSlide to the active slide.
  Set oSlide = Application.ActiveWindow.View.Slide

  ' Protect empty placeholders from being auto-filled by PowerPoint
  ProtectEmptyPlaceholders oSlide, True

  ' Insert Image to Footer
   Set oPicture = oSlide.Shapes.AddPicture("PathToFile.png", _
    msoFalse, msoTrue, 630, 390, 15, 15)

  ' Reset empty placeholders
  ProtectEmptyPlaceholders oSlide, False

  ' Move the picture to the centre of the slide. Select it.
  With ActivePresentation.PageSetup
    oPicture.Select
    oPicture.Name = "Dokumentverknüpfung"
  End With
End Sub

' Purpose:  Adds dummy text to empty placeholders so that pictures can
'           be inserted without PowerPoint automatically placing them
'           within the first empty placeholder that supports pictures.
' Inputs:   oSld - the slide to process.
'           bProtect - if true, adds the dummy text to empty
'           placeholders and if false, deletes the dummy text from.
' Author:   Jamie Garroch of YOUpresent.co.uk 04MAR2016
Sub ProtectEmptyPlaceholders(oSld As Slide, bProtect As Boolean)
  Const sText As String = "PROTECTED"
  Dim oShp As Shape
  For Each oShp In oSld.Shapes
    If oShp.Type = msoPlaceholder Then
      If oShp.PlaceholderFormat.ContainedType = msoAutoShape Then
        If bProtect And Not oShp.TextFrame2.HasText Then oShp.TextFrame2.TextRange.text = sText
        If Not bProtect And oShp.TextFrame2.TextRange.text = sText Then oShp.TextFrame2.DeleteText
      End If
    End If
  Next
End Sub

Answer 2

尝试将图片添加到新的临时幻灯片中，该幻灯片的布局为空白，不包含任何占位符。然后，将图片剪切粘贴到原来的幻灯片上，删除临时幻灯片。

sldTemp = pres.Slides.Add(1, PowerPoint.PpSlideLayout.ppLayoutBlank)

这种方法的优点是 (a) 无论占位符是多用途的还是特定于图片的，它都可以工作，并且在较小程度上，(b) 它不需要循环遍历幻灯片上的所有形状两次.缺点是插入和删除临时幻灯片时，您会看到一些屏幕闪烁。

更新：

这或许是避免插入空白幻灯片的更好方法。插入图片后，检查新插入的形状类型是否为占位符。如果是这样，那么我们需要 Cut() 图片并将其粘贴回幻灯片并调整形状的一些属性：

shpNew = Selection.SlideRange.Shapes.AddPicture(strImagePath, Office.MsoTriState.msoFalse, Office.MsoTriState.msoTrue, x, y)
If shpNew.Type = Office.MsoShapeType.msoPlaceholder Then
    'PowerPoint put the picture into a placeholder, against our wishes
    shpNew.Cut()
    ppApp.ActiveWindow.View.Paste()
    shpNew = ppApp.ActiveWindow.Selection.ShapeRange(1)
    With shpNew
        With .PictureFormat
            .CropBottom = 0
            .CropLeft = 0
            .CropRight = 0
            .CropTop = 0
        End With
        .ScaleHeight(1, Office.MsoTriState.msoTrue)
        .ScaleWidth(1, Office.MsoTriState.msoTrue)
        .Top = y
        .Left = x
    End With
End If

添加到 VBA (Powerpoint) 的图片被插入到占位符中

Picture added via VBA (Powerpoint) gets insertet into placeholder

powerpoint

vba

powerpoint-2010