How do I export all images from Excel and give a name from a related cell

Question

I've got an excel-sheet with about 200 rows. There are 200 images and 200 names. I have to extract every image and give the related name.

The structure is like this:

Image -> A2 Name -> B3 Image -> A5 Name -> B6 Image -> A8 Name -> B9 etc.

The image file ending doesn't matter...

How do I extract every image and give the proper name?

Solution

There's no easy way to save images from Excel, but PowerPoint has a handy Shape.Export method we can use. This macro should be used in your Excel file with all the images.

It saves all the images on Sheet1, assuming that their filename is one cell down and to the right from the top left of the image. Make sure to edit destFolder on the first line to the correct location. It overwrites any existing files without asking, so be careful.

Sub SaveImages()

    'the location to save all the images
    Const destFolder$ = "C:\users\...\desktop\"

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("sheet1")

    Dim ppt As Object, ps As Variant, slide As Variant

    Set ppt = CreateObject("PowerPoint.application")
    Set ps = ppt.presentations.Add
    Set slide = ps.slides.Add(1, 1)

    Dim shp As Shape, shpName$
    For Each shp In ws.Shapes
        shpName = destFolder & shp.TopLeftCell.Offset(1, 1) & ".png"
        shp.Copy
        With slide
            .Shapes.Paste
            .Shapes(.Shapes.Count).Export shpName, 2
            .Shapes(.Shapes.Count).Delete
        End With
    Next shp

    With ps
        .Saved = True
        .Close
    End With
    ppt.Quit
    Set ppt = Nothing

End Sub

Comments

[Admin]

Are your images actually within the cells, or just aligned in place of them? I'm suspicious you can't actually place an image in a cell. Is it possible to provide a sample?

[Admin]

It's not a solution, but note that the new .xlsx files are just zip file containers which contain individual files. You can rename from .xlsx to .zip and use your favorite unzipper to get access to the image files.

[Admin]

@MichaelKjörling Yeah, I know, but I think I have to write another script to rename those files..

[Admin]

Yes, I know, that's why I said it's not a solution. It's a trick though that many are unaware of, so I thought it might be useful to mention anyway.

[Admin]

You can use Shape.TopLeftCell.Address to get the location of the image.

[Admin]

@Kyle and how can I use the information I get from that

[Admin]

@Colin do you have powerpoint installed?

[Admin]

@Kyle Yes I do.

[Admin]

@Jonno Yes they are within the cells, I double checked that!

[Justin Obney]

So Much Win!!!!

[Amir]

I am getting some exception in With slide .Shapes.Paste .Shapes(.Shapes.Count).Export shpName, 2 .Shapes(.Shapes.Count).Delete End With