使用Excel VBA早期绑定在Powerpoint中更改图像

Question

我正在尝试更改现有演示文稿中的图片。

其中一段代码工作正常，但另一段代码不工作。

你能告诉我第一个不起作用吗？

Option Explicit

Sub Open_Access_Replace_Save()

Dim ppt As PowerPoint.Application
Set ppt = New PowerPoint.Application

ppt.Visible = msoCTrue

'To open Existing Powerpoint Presentation
Dim ppres As PowerPoint.Presentation
Set ppres = ppt.Presentations.Open("E:\ExcelPowerpoint\Opening Presentation and Acessing Shapes\Single Slide.pptx")

Dim pslide As PowerPoint.Slide

Set pslide = ppres.Slides(2)

'Image Change

'Attempt 1
Dim l As Single
Dim t As Single
Dim h As Single
Dim w As Single
Dim shap As PowerPoint.Shape

l = pslide.Shapes(8).Left
t = pslide.Shapes(8).Top
h = pslide.Shapes(8).Height
w = pslide.Shapes(8).Width
pslide.Shapes(8).Delete

'This is not working
Set pslide.Shapes(8) = 
pslide.Shapes.AddPicture("C:\Users\Vinod\Desktop\news.jpg", msoFalse, msoTrue, l, t, w, h)

'This is working
Set shap = pslide.Shapes.AddPicture("C:\Users\Vinod\Desktop\news.jpg", msoFalse, msoTrue, l, t, w, h)

Answer 1

您的代码将删除图片，然后尝试替换它。

这是一个更适合现实生活场景的sub，其中你还不知道照片的形状编号：

Sub ChangePictures()
  Dim oSlide As Slide
  Dim oShape As Shape, NewPic As Shape
  Dim pLeft!, pTop!, pWidth!, pHeight!

  For Each oSlide In ActivePresentation.Slides
    For Each oShape In oSlide.Shapes
      If oShape.Type = msoPicture Then
        With oShape
          pLeft! = .Left
          pTop! = .Top
          pWidth! = .Width
          pHeight! = .Height
          .PickUp
          .Delete
        End With
        Set NewPic = oSlide.Shapes.AddPicture2(FileName:="C:\TimeIcon.png", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=pLeft!, Top:=pTop!, Width:=pWidth!, Height:=pHeight!)
        NewPic.Apply
      End If
    Next oShape
  Next oSlide
End Sub