Search code examples
vbapowerpointworksheet

Convert all "Worksheet Objects" to images in powerpoint


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


Solution

  • 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