如何将图像从excel复制到PPT形状？
如何将图像从excel复制到PPT形状？
提问于 2019-05-16 12:31:49
我尝试使用以下代码，将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形状？
回答 3
Stack Overflow用户
回答已采纳
发布于 2019-05-16 13:04:12
不确定这是否有区别，但我喜欢显式地说明使用从Excel到PowerPoint的VBA时所指的是哪种对象：
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。
Stack Overflow用户
发布于 2019-05-16 13:30:50
这似乎是一个时间问题。它咬了一些人/一些个人电脑，而不是其他人。当PPT还在处理请求时，您粘贴形状，然后尝试使用它做一些事情，所以“做一些事情，它”部分失败。
通常的解决办法是给它一些额外的时间，并尝试一些额外的时间：
在模块的声明部分中，包括以下内容：
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)这对于32位PowerPoint来说是可能的；让它在64位PPT或两者中工作是可能的，但是对于另一个线程来说则是一个主题。
然后，在粘贴形状的子部分中，尝试粘贴几次，每次尝试之间暂停：
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 addStack Overflow用户
发布于 2019-05-16 14:23:00
为了将图像粘贴到PowerPoint中指定的形状中，有一些注意事项：
- 形状必须是允许图像的类型，例如某些内容占位符。不能将图像插入文本框、图表占位符等。
- 该形状必须是
Select编辑。虽然我们习惯于告诉人们使用 in Excel VBA，但是在PowerPoint和Word中，某些操作只能在对象处于视图和/或选中时执行。为了Select形状，我们需要Select幻灯片。
我已经通过将变量声明移到顶部来清理您的过程，修改了路径/幻灯片索引等。我创建了一个新的变量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表：
以及输出，将图像粘贴到适当的图像占位符中：
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/56168654
复制相关文章
相似问题
腾讯云开发者
