• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 823
  • Last Modified:

Compress pictures in multiple Word documents

Hello,

I need to compress pictures in a great number of Word documents. Is there any way of doing this on multiple documents at once in Word 2007, or do I have to open every single document and do it manually?

Thank you in advance!
0
Bstrdo
Asked:
Bstrdo
  • 2
2 Solutions
 
raysonleeCommented:
If you have a large number of documents that is enough to justify the effort, you can write an application to do it. Search for images in the doc, compress and save it. Otherwise you may have to do it manually one by one (perhaps with the help of macro).
0
 
GrahamSkanCommented:
Unfortunately the Compress functionality isn't implemented in the Word Object model, so programmatic manipulation would be very difficult. You may have to look for a third party application
0
 
xtermieCommented:
You could compress all images one by one though.
There is some code written here that works on Powerpoint...could take the same approach for Word
http://www.vbaexpress.com/forum/showthread.php?t=16134

Could try to do it...
Sub AACompressImages() 
    Dim oSh As Shape 
    Dim lCurrSlide As Long 
    Dim SlideName 
    Dim intCurrSlide 
    Dim oSlide As Slide 
    On Error Goto errhandler 
     
    Set oSlide = ActivePresentation.Slides("chartmanage") 
    lCurrSlide = oSlide.SlideIndex 
    ActiveWindow.View.GotoSlide lCurrSlide 
    Set oSh = Module3.GetShapeTaggedWith("picture", "fake", oSlide) 
    If Not oSh Is Nothing Then ' we found it
        ActivePresentation.Application.DisplayAlerts = ppAlertsNone 
        oSh.Select 
        SendKeys "%oi", False 
        SendKeys "%m", False 
        SendKeys "aw{ENTER}{ESC}{ESC}", True 
    Else 
        MsgBox "Image Not found" 
    End If 
     
    Exit Sub 
errhandler: 
    MsgBox "Error: " & Err.Number & " " & Err.Description 
     
End Sub

Open in new window

0
 
raysonleeCommented:
Here is a sample to locate images (inlineshapes) in Word and extract them, you have to repeat the same for shapes:

   wrdApp = CreateObject("Word.Application")
        wrdDoc = wrdApp.Documents.Open(sourceFile, , True, , , , , , , Word.WdOpenFormat.wdOpenFormatAuto)
        For Each shape As Word.InlineShape In wrdDoc.InlineShapes
            shape.Select()
            wrdDoc.ActiveWindow.Selection.CopyAsPicture()
            Dim dataObject As System.Windows.Forms.IDataObject = Clipboard.GetDataObject()
            If dataObject.GetDataPresent("Bitmap") Then
                Dim bmp As Bitmap = dataObject.GetData("Bitmap")
                bmp.Save(imagefilename)
            End If
        Next

Refer to here for sample of image compression using vb.net:
http://savotdane.blogspot.com/2009/08/how-to-compress-resize-image-in-net-c.html
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now