programmed removal of embedded pictures

**tryer** · 11-10-2010, 04:49 AM

Is it possible to export a number of pictures from a worksheet and name the files according to a filename in a cell.
To explain more clearly I have a worksheet (a few hundred lines in length) into which someone has imported a picture for the item decribed on each line.
Column A contains the part number of the item. The picture has been resized to fit over the cell in column D on each line. I would like to loop through each line and export each picture giving it a filename corresponding to the part number (and resizing it as well if possible). That way I can get the pictures out of the worksheet and reduce it's size (currently over 35MB) and be able to set up a hyperlink to the pictures stored in a folder.

I think there must be a way of doing this and any help pointing me in the right direction would be much appreciated

**Andy Pope** · 11-10-2010, 07:11 AM

Check out Stephen Bullen's PastePicture workbook. This has code that till allow you to copy picture to clipboard and then save contents to bmp file.

http://www.oaltd.co.uk/Excel/Default.htm

You can use the following in conjuction to export images

Sub PictureExport()

    Dim objIPicDisp As IPictureDisp
    Dim objPic As Object
    Dim strFile As String
    
    For Each objPic In ActiveSheet.Pictures
        strFile = ThisWorkbook.Path & Application.PathSeparator & objPic.TopLeftCell.EntireRow.Cells(1, 1).Value & ".bmp"
        ' copy picture
        objPic.CopyPicture xlScreen, xlBitmap
        
        'Retrieve the picture from the clipboard...
        Set objIPicDisp = PastePicture(xlBitmap)
        
        SavePicture objIPicDisp, strFile
    Next
    
End Sub