Convert all "Worksheet Objects" to images in powerpoint

Ronnie picture Ronnie · Oct 24, 2012 · Viewed 13.5k times · Source

Really not sure what stack site to place this on. Feel free to move it to the correct one. My question isn't really related to programming, but I have a ton of power points with these "Worksheet Objects" embedded in the slides. Some appear to be graphs from excel as well as other chart type items from Visio. I need to convert all these "Worksheet Objects" to just images within the slide.

My process right now is copy the object > Paste as Image > Move to the correct location > Delete the "Worksheet Object". It's a very time consuming and tedious process. Is there a macro I can write or something that can convert all these objects automatically? I tried googling and no luck so far

Answer

Steve Rindsberg picture Steve Rindsberg · Oct 26, 2012

This should get you started:

Sub ConvertAllShapesToPic()
    Dim oSl As Slide
    Dim oSh As Shape

    For Each oSl In ActivePresentation.Slides
        For Each oSh In oSl.Shapes
            ' modify the following depending on what you want to
            ' convert
            Select Case oSh.Type
                Case msoChart, msoEmbeddedOLEObject, msoLinkedOLEObject
                    ConvertShapeToPic oSh
                Case msoPlaceholder
                    If oSh.PlaceholderFormat.ContainedType = msoEmbeddedOLEObject _
                        Or oSh.PlaceholderFormat.ContainedType = msoLinkedOLEObject _
                        Or oSh.PlaceholderFormat.ContainedType = msoChart _
                        Then
                        ConvertShapeToPic oSh
                    End If
                Case Else

            End Select
        Next
    Next

End Sub

Sub ConvertShapeToPic(ByRef oSh As Shape)
    Dim oNewSh As Shape
    Dim oSl As Slide

    Set oSl = oSh.Parent
    oSh.Copy
    Set oNewSh = oSl.Shapes.PasteSpecial(ppPasteEnhancedMetafile)(1)

    With oNewSh
        .Left = oSh.Left
        .Top = oSh.Top
        Do
            .ZOrder (msoSendBackward)
        Loop Until .ZOrderPosition < oSh.ZOrderPosition
    End With

    oSh.Delete

End Sub