通过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中不使用填充图片空的占位符，但你可以通过确保没有空的占位符这样停止它。如果您在插入图片之前和之后调用子ProtectEmptyPlaceholder，则图片将作为新形状插入。

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 auot-fileld 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 center 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