Gfrktyl

My father called me up with an issue he needed help with. He had edited a Word document he received and found out he was unable to mail it, as it was extremely large. The number of pages was low, but there were images. I knew immediately that one of the images had to be a large file. I had him remove the images one by one till we found the offending image.

But, there has to be an easier way to do this, isnt there?

For pictures:

File--> "reduce file size" from there you can chose various options including compress all or only selected pictures. You can also have the file eliminate cropped regions data which may still be piggy-backing with the pictures.

This won't help you identify the offending image but is a quick way to compress all pictures in order to eliminate them as possible offenders.

Save the Word file .docx as .zip and open the zip folder wordmedia.

It will show the file sizes.

Open the Word (.docx) document with compression utility such as 7-Zip. Open folder wordmedia and there you will have a list of all embedded media files, with sizes.

This macro will tell you the PPI of each image and suggest reducing or increasing the size. I found it on the microsoft community. As noted, macro was made by Richard Michaels. FYI, it inserts a comment for each image, so if you have lots of comments, it could make a mess.

Sub PixelsMatter()

    'Created by Richard V. Michaels

    'http://www.greatcirclelearning.com

    'Creating custom and off-the-shelf productivity apps for Office



    On Error GoTo ErrHandler



    Dim doc As Word.Document, rng As Word.Range, iRng As Word.Range

    Dim shp As Word.Shape, iShp As Word.InlineShape

    Dim PixelCount As Integer, FullWidth As Integer, PPI As Integer

    Dim Mac As Boolean



    Set doc = Word.ActiveDocument

    Set rng = Word.Selection.Range

    'Check only the range selected, else check entire body of the document

    If rng.Start = rng.End Then Set rng = doc.Content



    #If Win32 Or Win64 Then

        'this is a PC

        PixelCount = 96

    #Else

        'this is a Mac

        PixelCount = 72

        Mac = True

    #End If



    For Each iShp In rng.InlineShapes

        'only looking for embedded or linked pictures

        If iShp.Type = wdInlineShapeLinkedPicture Or iShp.Type = wdInlineShapePicture Then

            'determining original width before scaling

            FullWidth = iShp.Width / (iShp.ScaleWidth / 100)

            'calculate PPI density based on the current scaled size of inserted image

            PPI = FullWidth / (iShp.Width / PixelCount)

            Select Case PPI

                Case Is < 150

                    iShp.Range.Comments.Add iShp.Range, "PPI is " & PPI & " and will result in poor print quality. " & _

                            "We suggest either reducing the size of the picture in the document or replacing with a higher quality source image."

                Case Is < 200

                    iShp.Range.Comments.Add iShp.Range, "PPI is " & PPI & ", which is marginal for a good print quality. " & _

                            "We suggest you print a sample and check if the print quality is satisfactory for your needs. " & _

                            "Higher print quality can be achieved by either reducing picture size or replacing with a higher quality source image."

                Case Is < 240

                    'PPI density is optimal, no comment made

                Case Else

                    iShp.Range.Comments.Add iShp.Range, "PPI is " & PPI & " and does not contribute to better print quality... " & _

                            "it is only creating a larger than necessary file size for this document. We suggest replacing the image with a more appropriately sized source image."

            End Select

        End If

    Next



    If Mac Then GoTo ErrHandler

    'With a Mac running Office 2011 there is no need to go further

    'The excessively buggy Office 2011 VBA errantly places all "floating" shapes into the inline shapes collection

    'No other PC version of Office VBA does this and if the following code is executed on a Mac, double comments

    'would be placed on all floating shapes that met the PPI criteria specified in the following Select Case command.



    If doc.Shapes.count = 0 Then GoTo ErrHandler

    Dim wrapType As Integer, i As Integer



    For i = doc.Shapes.count To 1 Step -1

        Set shp = doc.Shapes(i)

        If shp.Type = Office.MsoShapeType.msoPicture Or _

            shp.Type = Office.MsoShapeType.msoLinkedPicture Then

            If shp.WrapFormat.Type <> Word.WdWrapType.wdWrapNone Then

                wrapType = shp.WrapFormat.Type

                Set iShp = shp.ConvertToInlineShape

                If iShp.Range.InRange(rng) Then

                    'determining original width before scaling

                    FullWidth = iShp.Width / (iShp.ScaleWidth / 100)

                    'calculate PPI density based on the current scaled size of inserted image

                    PPI = FullWidth / (iShp.Width / PixelCount)

                    Select Case PPI

                        Case Is < 150

                            iShp.Range.Comments.Add iShp.Range, "PPI is " & PPI & " and will result in poor print quality. " & _

                                    "We suggest either reducing the size of the picture in the document or replacing with a higher quality source image."

                        Case Is < 200

                            iShp.Range.Comments.Add iShp.Range, "PPI is " & PPI & ", which is marginal for a good print quality. " & _

                                    "We suggest you print a sample and check if the print quality is satisfactory for your needs. " & _

                                    "Higher print quality can be achieved by either reducing picture size or replacing with a higher quality source image."

                        Case Is < 240

                            'PPI density is optimal, no comment made

                        Case Else

                            iShp.Range.Comments.Add iShp.Range, "PPI is " & PPI & " and does not contribute to better print quality... " & _

                                    "it is only creating a larger than necessary file size for this document. We suggest replacing the image with a more appropriately sized source image."

                    End Select

                   iShp.ConvertToShape

                   shp.WrapFormat.Type = wrapType

                Else

                    iShp.ConvertToShape

                    shp.WrapFormat.Type = wrapType

                End If

            End If

        End If

    Next



ErrHandler:

    Select Case Err

        Case 0

            MsgBox "Action Complete", vbInformation, "Pixels Matter"

        Case Else

            MsgBox Err.Number & vbCr & Err.Description, vbExclamation, "Pixels Matter"

            Err.Clear

    End Select



End Sub

Probably the easiest way is to just compress each image. Click the Format menu and choose Compress Pictures. This will remove any unneeded image data including parts that have been cropped out but are still kept in the image data.

To expand on the great answer by @TommyZG, which worked best for me: you can also delete offending big pictures from the archive. I had a case when many people worked on a file, and big pictures were 'stuck' in the word file even when not used anymore.