Save selected images in a row cell from a report document to a folder

Hi all , my first post here so hope you can help.

In short I am trying to have a macro/script/program that allows our trainers to select all images in a cell in their word document reports and save them to a specific folder. The purpose so they can then use powerpoint to create an album for the pictures.

Back ground

Our Trainers create word reports, the reports are created row by row with one of the cells in the row holding a range of pictures (1-30+) When it gets to over 5 pictures it is a bit time consuming to open each picture individually to view and check it. So we would like to create a photo album where there is 5 or more pictures in a cell row.

To do this we need to extract the specific images and place them in a folder for powerpoint to import from. This is where the difficulty lies, i have seen a few helpful posts but they look to extract all images not speciifc ones and we only need to do ths for say 5 rows in 40.

So if you can help that would be great

Cross-posted at: http://www.msofficeforums.com/word-v...ages-cell.html

Please read VBA Express' policy on Cross-Posting in item 3 of the rules: http://www.vbaexpress.com/forum/faq...._new_faq_item3

There is no built-in function to do this in Word VBA.

The processes you have described that save all the images access them from the XML folders saved in the zip file that is DOCX e.g. http://www.gmayor.com/extract_images_from_word.htm .

It is not possible using that method to extract only those in your selection.

You may be able to do it by copying each image range to the clipboard (see below) and then save the clipboard content in turn as a picture perhaps using code at http://www.vbaexpress.com/forum/show...ata-as-picture but I have not tried it and I suspect the image quality will not be as good as extracting directly from the XML folder.

Code:

---

Sub Macro1()
Dim oShape As InlineShape
Dim oRow As Row
Dim oCell As Cell
    If Selection.Information(wdWithInTable) Then
        For Each oRow In Selection.Rows
            For Each oCell In oRow.Cells
                For Each oShape In oCell.Range.InlineShapes
                    oShape.Range.CopyAsPicture
                    'save the clipboard content here
                Next oShape
            Next oCell
        Next oRow
    End If
lbl_Exit:
    Set oShape = Nothing
    Set oRow = Nothing
    Set oCell = Nothing
    Exit Sub
End Sub

---