MS Word 2013 VBA - Image Compression Fix

[kennyrogersjr]

I figured out a way to eliminate that frustrating Compress Pictures bug that won't allow you to really compress that image.

Scenario: You re-size an image and you also crop out some white space. You save your document, which is set to compress images on save, and continue editing. Well, you go to email that document you created and realize that the file size is grossly out of proportion to what it should be. So you go back to check on the culprit and, low and behold, it's that image you compressed. You take a look at it and the scale ratio is still set to 33%, in some cases the cropped area wasn't deleted, and it didn't even compress.

Fix: You can manually Ctrl + X and Ctrl + Shift + V (Paste Special) the image to allow MS Word to recognize the image as an image, or you can run the below code:

Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Public Function ClearClipboard()
    OpenClipboard (0&)
    EmptyClipboard
    CloseClipboard
End Function
Sub CompressImageFix()

Dim s As Shape

Set docAD = ActiveDocument

For Each s In docAD.Shapes
    s.Select
    Selection.Cut
    Selection.PasteSpecial Link:=False, DataType:=15, Placement:=wdTightAll, DisplayAsIcon:=False
    Selection.Collapse    'IMPORTANT - Allows deselection of current object
    ClearClipboard          'IMPORTANT - Function stops unintentional pasting of prior copied objects over next object
Next s

End Sub

This code is really intended for those of us that need a couple hundred images to process. Feel free to criticize, it won't hurt my feelings. Plus, it helps others, too.

Ken

 

[ericward]

I figured out a way to eliminate that frustrating Compress Pictures bug that won't allow you to really compress that image.

This code is really intended for those of us that need a couple hundred images to process. Feel free to criticize, it won't hurt my feelings. Plus, it helps others, too.

Ken

"Feel free to criticize, it won't hurt my feelings."Thank you for sharing this for us. And I will try and give the feedback to you.