简体   繁体   English

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

[英]Changing Image in Powerpoint using Excel VBA Early Binding

I'm trying to change the pictures that are there in the existing Presentation.我正在尝试更改现有演示文稿中的图片。

one of the code is working but other is not.其中一个代码正在运行,但其他代码不起作用。

Can you tell me the first one is not working?你能告诉我第一个不起作用吗?

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)

Your code deletes the picture, then tries to replace it.您的代码会删除图片,然后尝试替换它。

Here's a sub more suited to a real-life scenario, where you don't already know the shape number of the photo:这是一个更适合现实生活场景的子,在这种场景中,您还不知道照片的形状编号:

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

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM