Macro to reduce image sizes in a ppt that worked in ppt 2007 but not in ppt 2013

Hi,

I've a macro that I used with some ppt's in office 2007 to reduce the size of some links within the ppt to an excel file. Recently I've installed the Office 2013 and the macro crashed with the following error:

    Shape.select: invalid request. To select a shape, its view must be active

Here is the code I have:

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

I believe now, I've to activate each shape in every slide but I don't know how to do it. I've tried to use an integer to point to each slide but I had no success.
Can someone help me?!

Originally Posted by xladept

Maybe you don't need the select, try just commenting it out.

Doing that, the error went to the paste data type. It gave me this:

Shapes.PasteSpecial: Invalid request. The specified data type is unavailable.

???

Originally Posted by protonLeah

• You do not need to select the slide
• You are using oSh as a For..Next control variable; but then, inside the loop you are pointing it to two other shapes. You need to use a separate variable for that:
  Set oSh = curr_slide.Shapes(3) ... ---->....Set curr_shp = curr_slide.Shapes(3), etc.
• I don't think you can use .PasteSpecial with the .Cut. Instead, maybe Copy, PasteSpecial, Cut curr_shp.Shapes(3) .... [What happens if there is no third shape?]

I'm not sure about using SET with PasteSpecial

I commented out the select and it gave me the error related with the data type. I tried to use a separate variable for the shapes inside the loop but it also still gives me the data type error. Cut or copy also give the same result. There was no problem with the datatype in Office 2007 =\

tks for the help!

Sub reduce()
 For Each curr_slide In ActivePresentation.Slides
       For Each oSh In curr_slide.Shapes
           If oSh.Type = msoLinkedOLEObject Then
             With curr_slide.Shapes(3)
                   '.LinkFormat.BreakLink
                   .Select
                   .LockAspectRatio = False
                   .Height = 14 * 28.33
                   .Width = 33.5 * 28.33
                   .Cut
                   Dim PastedShape as Shape
                   Set oPastedShape = curr_slide.Shapes.PasteSpecial(DataType:=ppPastePNG)
                  
                   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

Hi

I've solved the problem, basically by defining my datatype with the associated ID number instead of indicating the traditional "ppPasteXPTO". I've also used the number of the Bitmap format file instead of the PNG since it allows me to reduce the size of the ppt but it's not so heavy in the image compression like the PNG is. Here is the final code:

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