将调整大小的图片从Excel导出到PowerPoint 2010

时间:2017-03-11 12:08:35

标签: excel excel-vba powerpoint-vba powerpoint-2010 vba

我创建了一个代码,可以将图片从Excel复制到新的PowerPoint演示文稿中。该代码适用于MS Office 2016,但 MS Office 2010.特别是,导出到PowerPoint的图片将不会在2010年的.pptx中调整大小。

我该如何解决这个问题?

以下是在MS 2010中无效的有问题的代码:

    Application.Goto Reference:="Full_Account_Performance"
    Application.CutCopyMode = False
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    PPPres.Slides(x).Shapes.PasteSpecial

    On Error Resume Next                
    With PPApp.ActiveWindow.Selection.ShapeRange 
        .ScaleHeight 0.435, msoFalse, msoScaleFromTopLeft 
        'Powerpoint 2010 ingnors it... but in 2016 it is fine
        .Left = 10
        .Top = 55
    End With

2 个答案:

答案 0 :(得分:2)

在PowerPoint 2010中,它有时会在使用Shapes.PasteSpecial命令粘贴图片后跳过这些行(它们不会被跳过,只是代码在完成粘贴图片之前运行它们)。

有一种解决方法,您可以添加一秒的延迟,并且代码将起作用(下面的行不会被跳过)。

下面的代码会在PowerPoint中为粘贴的图片设置Object,之后只需修改myShape属性。

注意:以下代码使用 延迟绑定 ,但它也适用于 早期绑定

<强>代码

Dim PPPres                              As Object
Dim PPSlide                             As Object
Dim myShape                             As Object

' set the slide object - x is the slide number
Set PPSlide = PPPres.Slides(x)  

' Set an Object to the Pasted PowerPoint picture
Set myShape = PPSlide.Shapes.PasteSpecial(0, msoFalse) ' ppPasteDefault = 0
With myShape
    ' it skips the lines below, add a delay
    Application.Wait Now + TimeValue("00:00:01")

    .ScaleHeight 0.435, msoFalse, msoScaleFromTopLeft
    .Left = 10
    .Top = 55
End With

答案 1 :(得分:0)

这似乎是个问题:

With PPApp.ActiveWindow.Selection.ShapeRange 

尝试:

With PPPres.Slides(x).Shapes(y)

其中y =您刚刚粘贴的图片。由于您没有设置对它的引用,您可能需要遍历幻灯片中的形状以找到它的形状。