Question

我在Office 2007中使用的一些宏用于将ppt中的某些链接的大小减小到excel文件。最近我安装了Office 2013，宏崩溃了，出现以下错误：

Shape.select：无效请求。要选择形状，其视图必须处于活动状态

以下是代码：

Sub reduce()
 For Each curr_slide In ActivePresentation.Slides
     curr_slide.Select
       For Each oSh In curr_slide.Shapes
           If oSh.Type = msoLinkedOLEObject Then
            Set oSh = curr_slide.Shapes(3)

             With oSh
                   '.LinkFormat.BreakLink

                   .Select
                   .LockAspectRatio = False
                   .Height = 14 * 28.33
                   .Width = 33.5 * 28.33
                   .Cut
                   Set oSh = curr_slide.Shapes.PasteSpecial(DataType:=ppPastePNG)
                   .Height = 10 * 28.33
                   .Width = 23 * 28.33
                   .Left = 1.2 * 28.33
                   .Top = 1.85 * 28.33
                   .ZOrder (msoSendToBack)
               End With
           End If
       Next oSh
   Next curr_slide
End Sub

我现在相信，我已经在每张幻灯片中激活每个形状，但我不知道该怎么做。

Answer 1

问题可能只是因为您处于不允许选择幻灯片的视图中，所以......不要选择幻灯片。没有必要：

Sub reduce()
 For Each curr_slide In ActivePresentation.Slides
     ' you don't need to select the slide to work with it
     'curr_slide.Select
       For Each oSh In curr_slide.Shapes
           If oSh.Type = msoLinkedOLEObject Then

            ' Is there something magical about the third shape?
            ' And you're messing up your loop by setting
            ' oSh to a different shape here. 
            'Set oSh = curr_slide.Shapes(3)
            ' Instead, do this:
             With curr_slide.Shapes(3)
                   '.LinkFormat.BreakLink

                   .Select
                   .LockAspectRatio = False
                   .Height = 14 * 28.33
                   .Width = 33.5 * 28.33
                   .Cut

                   ' And again, setting oSh to a different
                   ' value within the loop is bad practice:
                   Dim PastedShape as Shape
                   Set oPastedShape = curr_slide.Shapes.PasteSpecial(DataType:=ppPastePNG)
                   ' and this, if you want the following code
                   ' to affect the pasted shape:
                   With oPastedShape
                   .Height = 10 * 28.33
                   .Width = 23 * 28.33
                   .Left = 1.2 * 28.33
                   .Top = 1.85 * 28.33
                   .ZOrder (msoSendToBack)
                   End with

               End With
           End If
       Next oSh
   Next curr_slide
End Sub

Answer 2

我已经解决了这个问题，基本上是通过使用相关的ID号定义我的数据类型而不是指示传统的“ppPasteXPTO”。我还使用了Bitmap格式文件的编号而不是PNG，因为它允许我减小ppt的大小，但它在图像压缩方面不像PNG那么重。这是最终的代码：

Sub reduce()

Dim shp As Shape
Dim sld As Slide

'Loop Through Each Slide in ActivePresentation
For Each sld In ActivePresentation.Slides
    For Each shp In sld.Shapes
     If shp.Type = msoLinkedOLEObject Then
        shp.Cut
        Dim oShp As ShapeRange
        Set oShp = sld.Shapes.PasteSpecial(DataType:=1)
     End If
    Next shp
  Next sld
End Sub

用于缩小ppt中图像大小的宏，该ppt在2007年ppt中有效但在2013年ppt中没有

2 个答案: