How do you compress all pictures in Excel with VBA?

[tpthatsme]

Our Excel files are stored on SharePoint Online and they are very picture-heavy. Some files reach 300MB and we need a way to reduce the file size. If I run the Save As command I can get to the tools menu to compress images and bring a 300MB file down to 100MB, but how do I do this with VBA? I have tried running a loop and applying this compression but it takes hours. When I use the Save As tool, it takes only seconds.

I have also tried to record a macro of the Compress Pictures tool, but the macro is always blank.

Is there a quick VBA way to do this? I woud like to put this in a macro to trigger when the file is closed.

 

[Logit]

You can batch compress images with this free software :

IrfanView - Official Homepage - One of the Most Popular Viewers Worldwide

I understand Excel 2002 had a Picture Compress option. Might be something to look into.

 

[tpthatsme]

You can batch compress images with this free software :

IrfanView - Official Homepage - One of the Most Popular Viewers Worldwide

I understand Excel 2002 had a Picture Compress option. Might be something to look into.

Excel with Office 365 has Picture Compress option. The problem is we have hundreds of working files that will need to be compressed every time they are edited with new content. Is there a VBA way to do this Excel built-in feature? We will have hundreds more in the future. I am looking for a sustainable solution and not a one-time fix.

 

[Logit]

Yes, you can create a VBA macro to open each folder that has images and batch compress those images. If you maintain all new content in specific folder / s, then create the vba macro based on
that reoccurring folder. In other words, use that specific folder for compressing images only. Then move the images from that folder to their final location.

OR ... check this out and see if it is in your 365 copy of Excel :

Compress Images

 

[tpthatsme]

Yes, you can create a VBA macro to open each folder that has images and batch compress those images. If you maintain all new content in specific folder / s, then create the vba macro based on
that reoccurring folder. In other words, use that specific folder for compressing images only. Then move the images from that folder to their final location.

OR ... check this out and see if it is in your 365 copy of Excel :

Compress Images

Thank you so much for your help, but I don't think I am explaining my problem correctly. I am not trying to make a tool that batch-compresses images. Let's say I have an Excel file and in that Excel file I have several Worksheets with several pictures in each Worksheet. The pictures are all screenshots that show proof of some work that is to be done. This file is already a macro file for other purposes. This file was originally created from a template. Now imagine hundreds of these files from hundreds of different users all using the same template to create their files. Now imagine that these Excel files are 300+ MB large and that SharePoint online doesn't allow Version history less than 100, so a 300MB file can take up much more than the face value of the file itself.

There is a way to compress all images in the Excel file manually when you save the document. My question is: Can you do this via VBA? I have tried to use the following VBA and it kind of works, but it slowly works through all images and sheets and takes hours instead of the Save As tool that takes seconds.

Sub WorksheetLoop()

 Dim c As Integer
 Dim n As Integer
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 c = ActiveWorkbook.Worksheets.Count
 For n = 1 To c Step 1
    Last = Worksheets(n).Cells(Rows.Count, "A").End(xlUp).Row
    For I = Last To 1 Step -1

        Worksheets(n).Shapes.SelectAll
        SendKeys "%e", True
        SendKeys "~", True
        Application.CommandBars.ExecuteMso "PicturesCompress"
    Next I
 Next n
    Application.DisplayAlerts = True
 End Sub

I need something like this, but when I record this macro it ends up being empty.

 

[Logit]

Make a copy of your workbook to experiment on.

Paste the following edited code into a regular module :

' Represents a utility class for optimizing the execution of a VBA macro code.
    Public Class MacroOptimizer
 
        ' Disables screen updating and display alerts in Excel application.
        Public Sub DisableExcelSettings()
            Application.ScreenUpdating = False
            Application.DisplayAlerts = False
        End Sub
 
        ' Enables screen updating and display alerts in Excel application.
        Public Sub EnableExcelSettings()
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
        End Sub
 
        ' Compresses all pictures in each worksheet of the active workbook.
        Public Sub CompressPictures()
            Dim workbook As Workbook = Globals.ThisWorkbook.Application.ActiveWorkbook
            Dim worksheetCount As Integer = workbook.Worksheets.Count
 
            For n As Integer = 1 To worksheetCount
                Dim worksheet As Worksheet = workbook.Worksheets(n)
                Dim lastRow As Integer = worksheet.Cells(worksheet.Rows.Count, "A").End(XlDirection.xlUp).Row
 
                For i As Integer = lastRow To 1 Step -1
                    worksheet.Shapes.SelectAll()
                    SendKeys.SendWait("%e")
                    SendKeys.SendWait("~")
                    Application.CommandBars.ExecuteMso("PicturesCompress")
                Next i
            Next n
        End Sub
 
    End Class
 
End Namespace
 
' Usage example for the MacroOptimizer class.
 
Module Program
 
    Sub Main()
 
        ' Example: Optimize the execution of the VBA macro code.
        Dim optimizer As New MacroUtils.MacroOptimizer()
        optimizer.DisableExcelSettings()
        optimizer.CompressPictures()
        optimizer.EnableExcelSettings()
 
    End Sub
 
End Module

Then run the macro entitled MAIN

I don't have a copy of Excel 365 to use here so the code is untested. See if it speeds things up for you.