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

2023年12月16日 567次阅读

我有一个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

如果幻灯片上没有未使用的占位符,此代码可以正常工作.
如果有占位符,Picture会自动插入此占位符.

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

谢谢,
延

最佳答案 没有办法明确告诉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
点赞