Programmatic Access to PowerPoint

Question

Is there a way to access Powerpoint functions from outside of Powerpoint (like Excel Serivces)? I need to remove all of the cropped areas of all images across hundreds of PPT files in order to remove potentially sensitive info that was manually cropped out of an image. The manual way to do it is to "Compress Images" from within PowerPoint. I am trying to figure out how to do this programmatically.

Answer 1

Hello @John Mas

Spent all day on this one and hope it works for you!

Note: Make sure you add the directory where the files are and put the file names in the array (called files). You should test this on a test directory with test presentations before pushing it into production.

This script is to blur out all images in every presentation on every slide. (it makes it small, copies the picture, pastes the picture, and resizes the width/height so it looks blurry as seen below)

Before:

After:

Part of the script that got me going was from https://www.pcreview.co.uk/threads/compress-pictures-using-vba.2740465/ and https://www.mrexcel.com/board/threads/vba-check-if-shape-is-a-picture.1023100/ (for finding out msoPicture property) - the rest of it was using Microsoft Learn.

1) Open a new PowerPoint Presentation > Go to File > Options > Customize Ribbon > Add Developer Tab

2) Create a new Macro and open up Visual Basic and paste the following code and make edits to the directory and files array. Once done, press the play button and let the script open, do its work, save, and close the presentations.

Sub compressPictures()  

' Set your directory to your files here.  
directory = "C:\Users\yourdirectory\Downloads\"  

' Create Array for files  
Dim files As Variant  
files = Array("pres3.pptx", "pres4.pptx")  

For Each file In files  

    Presentations.Open directory & file  

    Dim counter As Integer  
    counter = 1  
    myCount = ActivePresentation.Slides.Count  

    ' MsgBox myCount - debug  

    While counter <= myCount  

    ' slideCount = ActivePresentation.Slides(counter).Shapes.Count  
    ' MsgBox slideCount - debug  

        Set myDocument = ActivePresentation.Slides(counter)  

        For Each Shape In ActivePresentation.Slides(counter).Shapes  

            If Shape.Type = msoPicture Then  

                storeWidth = Shape.Width  
                storeHeight = Shape.Height  

                Shape.LockAspectRatio = msoTrue  
                Shape.Width = 10  
                Shape.Copy  

                ActivePresentation.Slides(counter).Select  

                ActiveWindow.View.PasteSpecial ppPastePNG  
                With ActiveWindow.Selection.ShapeRange(1)  
                    .Left = Shape.Left:  
                    .Top = Shape.Top  
                    .Width = storeWidth:  
                    .Height = storeHeight  
                End With  

            Shape.Delete  

            End If  
        Next  

        counter = counter + 1  

    Wend  

    ActivePresentation.SaveAs directory & file  

    ActivePresentation.Close  

Next  

End Sub  

Docs used:

• https://learn.microsoft.com/en-us/office/vba/api/powerpoint.shapes.range
• https://learn.microsoft.com/en-us/office/vba/api/powerpoint.shapes.pastespecial
• https://learn.microsoft.com/en-us/office/vba/api/powerpoint.presentation.saveas
• https://learn.microsoft.com/en-us/office/vba/api/powerpoint.presentation.close
• https://learn.microsoft.com/en-us/office/vba/language/concepts/getting-started/using-arrays
• https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/whilewend-statement

---

If this is helpful please don't forget to mark as correct answer. This one was a lot of work and hope it helps you out.