在 ppt 2007 中有效但在 ppt 2013 中无效的 ppt 中用于减小图像大小的宏答案

【问题标题】：Macro to reduce image sizes in a ppt that worked in ppt 2007 but not in ppt 2013在 ppt 2007 中有效但在 ppt 2013 中无效的 ppt 中用于减小图像大小的宏
【发布时间】：2015-12-22 09:00:02
【问题描述】：

我有一个宏，我在 Office 2007 中与一些 ppt 一起使用，以减小 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

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

【问题讨论】：

标签： size powerpoint shape reduce

【解决方案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

【讨论】：

我已经尝试过您的方法，但现在出现以下错误：“Shape.select：无效请求。要选择形状，其视图必须处于活动状态”。如何激活每张幻灯片中的形状？
我还注释掉了循环中的“.select”，但它给了我一个与数据类型相关的错误：“Shapes.PasteSpecial：无效请求。指定的数据类型不可用。”
抱歉，我错过了第二个 .Select。你说得对，应该删掉。并将 Dim PastedShape 更改为 Dim oPastedShape。这样可以排序吗？
"Shapes.PasteSpecial：无效请求。指定的数据类型不可用。" =\
看到这个：stackoverflow.com/questions/24675562/… 并将违规行更改为 Set oPastedShape = curr_slide.Shapes.PasteSpecial(DataType:=ppPastePNG)(1)

【解决方案2】：

我已经解决了这个问题，基本上是通过使用关联的 ID 号定义我的数据类型，而不是指示传统的“ppPasteXPTO”。我还使用了位图格式文件的数量而不是 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

【讨论】：