如何将图像从excel复制到PPT形状？

我尝试以下代码，从excel复制到ppt：

  Dim presentation As Object
  Set ppt = CreateObject("PowerPoint.Application")
  Set presentation = ppt.Presentations.Open2007("D:\temp.pptx", MsoTriState.msoFalse, MsoTriState.msoFalse, MsoTriState.msoTrue)

 Dim oSlide As Object        
 Set oSlide = presentation.Slides(7)
 Dim oSheet As Worksheet
 Set oSheet = ThisWorkbook.Sheets(2)
 Dim oImageOb As Object
 Set oImageOb = oSheet.Shapes(1)
 oImageOb.Copy

 oSlide.Shapes.PasteSpecial DataType:=2

但PPT在执行

PasteSpecial

后退出

---

如何将图像从excel复制到PPT形状？

不确定这是否有区别，但我想明确说明在使用VBA从excel复制到PowerPoint时所指的对象类型：

Dim presentation As PowerPoint.Presentation
Set ppt = New PowerPoint.Application
Set presentation = ppt.Presentations.Open2007("D:\temp.pptx", MsoTriState.msoFalse, MsoTriState.msoFalse, MsoTriState.msoTrue)

Dim oSlide As Object        
Set oSlide = presentation.Slides(7)
Dim oSheet As Worksheet
Set oSheet = ThisWorkbook.Sheets(2)
Dim oImageOb As Object
Set oImageOb = oSheet.Shapes(1)
oImageOb.Copy

oSlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile

---

这段代码对我来说很好（当然，只是替换了PPT文件的位置）。我所说的“工作”，是指图形/图像/形状从excel复制到powerpoint，之后powerpoint不会关闭这似乎是一个时间问题。它咬伤了一些人/一些电脑，而不是其他人。您粘贴形状，然后在PPT仍在处理请求时尝试对其执行操作，因此“使用它执行操作”部分失败

通常的解决方法是给它一点额外的时间，然后再尝试几次：

在模块的声明部分，包括以下内容：

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

这是针对32位PowerPoint的；让它在64位PPT或两者中工作是可能的，但主题不同

然后在sub中粘贴形状的部分，尝试粘贴几次，每次尝试之间暂停：

Dim oShp as Shape
Dim x as Long

On Error Resume Next

For x = 1 to 3 ' or whatever number you want to try
  Set oShp = oSlide.Shapes.PasteSpecial DataType:=2
  Sleep(1000)  ' Adjust this as needed
  If Not oShp is Nothing Then
    Exit For
  End If
Next

If oShp is Nothing Then
  ' It didn't work.
  ' Do whatever you need to do to recover
End If

On Error GoTo YourRegularErrorHandler
' Which you should add

---

要将图像粘贴到PowerPoint中的指定形状，请注意以下几点：

形状的类型必须允许使用图像，例如某些内容占位符。不能将图像插入文本框、图表占位符等

形状必须

Select

ed。虽然我们习惯于告诉人们这样做，但在PowerPoint和Word中，某些操作只能在对象处于视图和/或选中时执行。为了

选择

形状，我们需要

选择

幻灯片

通过将变量声明移到顶部，修改路径/幻灯片索引等，我清理了您的过程。我创建了一个新变量

pptShape

，我们将使用它来处理幻灯片上的特定形状实例

请注意，我已经更改了路径和幻灯片/形状索引

Option Explicit

Sub foo()
Dim ppt As Object 'PowerPoint.Application
Dim oSlide As Object 'PowerPoint.Slide
Dim pptShape As Object 'PowerPoint.Shape
Dim oImageOb As Object
Dim oSheet As Worksheet
Dim pres As Object 'PowerPoint.Presentation

Set ppt = CreateObject("PowerPoint.Application")
Set pres = ppt.Presentations.Open2007("c:\debug\empty ppt.pptx", MsoTriState.msoFalse, MsoTriState.msoFalse, MsoTriState.msoTrue)
Set oSlide = pres.Slides(3)

Set oSheet = ThisWorkbook.Sheets(1)  ' ## MODIFY AS NEEDED
Set oImageOb = oSheet.Shapes(1)      ' ## MODIFY AS NEEDED
oImageOb.Copy

Set pptShape = oSlide.Shapes(1)      ' ## MODIFY AS NEEDED

'## to preserve aspect ratio and prevent stretching/skewing image:
pptShape.Width = oImageOb.Width
pptShape.Height = oImageOb.Height

' ## Select the slide
oSlide.Select
' ## Selct the shape
' ## NOTE: This shape MUST be of a type that contains a picture frame, otherwise
'          an error will occur
pptShape.Select

' ## All of the following methods work for me:
'ppt.CommandBars.ExecuteMso "PasteJpeg"
'ppt.CommandBars.ExecuteMso "PasteBitmap"
'ppt.CommandBars.ExecuteMso "PasteAsPicture"
ppt.CommandBars.ExecuteMso "Paste"


End Sub

这是我的Excel工作表和图像：

和输出，将图像粘贴到相应的图像占位符中：

---

oSlide

未定义。请包含相关代码部分或完整代码。它已定义，我已更新代码。我已尝试更改为值=2，它仍将退出。通过“PPT在执行

PasteSpecial

后退出”，您的意思是PowerPoint应用程序关闭吗？当我获取该代码并将其放入

子测试（）中时

，我得到的正是您所期望的，因此我无法重现您的问题。您使用的是什么版本的Office？您可以尝试几次。（注意：这不会有什么区别）一个

对象

分配了

演示文稿的返回。Open/Open2007

将返回

PowerPoint.Presentation

类的一个实例，无论您使用的是后期绑定还是早期绑定，无论您是否添加了对PPT对象模型的显式引用。@DavidZemens同意，但由于我无法复制Ps问题，我想它无论如何都值得一试…但是你当然正确测试并确认了这对后期绑定也有效。对不起。它正在工作。我在调试中运行了PasteSpecial。所以它退出了PPT应用程序。什么是占位符？它是矩形吗？a是PPT对象模型中的一种特定类型的形状，它是演示文稿SlideMaster的一部分布局。它名义上是一个“矩形”（即，它通常是一个四边形/平行四边形和90度角），但它不是“矩形”“您可以从“插入>形状>矩形”选项中获得。这种形状可以用剪贴板或文件位置的图片填充，但这不是同一件事，不能用同样的方式实现。谢谢。我可以添加一个占位符。但在将图像粘贴到占位符之后。如何使图像适合占位符的大小或使占位符适合图像？图像粘贴到占位符后，如果excel上的图像具有裁剪

pptShape.Width=oImageOb.Width

，并且下一行具有

。Height

则不正确，否？