• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Extract images, automatically name

Hi all,

Decent Excel user here, but absolute amateur VBA user.

I have an excel doc (see attached example file) with a bunch of images pasted on top of a bunch of cells (but all fully within one cell), all in one column. Another column has names for each of these images. How can I somehow extract each of these images and automatically name them based on the name column?

For the test file, ideally I'd like to get a folder with three image files named house, cat, and dog. Is this possible? THANK YOU!!!
__________________________________________________________________
Mod edit : thread moved to appropriate forum !
 

Attachments

  • TestFileImages.xlsx
    93.1 KB · Views: 18
William

Firstly, Welcome to the Chandoo.org Forums

I would use some simple VBA Code like:

Code:
Sub Lookup_Picture_Name()
Dim myCell As Range
Dim p As Picture

For Each myCell In Range("B2:B4")
  For Each p In ActiveSheet.Pictures
  Debug.Print p.TopLeftCell.Address = myCell.Address
 
  If p.TopLeftCell.Address = myCell.Address Then
  p.Name = myCell.Offset(, -1).Text
  End If
  Next
 
Next myCell
End Sub

Copy this to a code module of the worksheet where the images are then run it
It assumes the Top Left corner of the image is within the cell
 
Hi !

To export images to hard disk, run this demonstration :​
Code:
Sub RangeExport(Rg As Range, DESTINATION$)
    With Rg
             .CopyPicture
        With .Parent.ChartObjects.Add(.Left, .Top, .Width, .Height).Chart
             .Paste:  .Export DESTINATION:  .Parent.Delete
        End With
    End With
End Sub

Sub Demo()
    VA = Cells(1).CurrentRegion.Columns(1).Value
    L& = UBound(VA):  If L = 1 Then Beep: Exit Sub
    D$ = ThisWorkbook.Path & "\"
       Application.ScreenUpdating = False
    ActiveWindow.DisplayGridlines = False
    For R& = 2 To L:  RangeExport Cells(R, 2), D & VA(R, 1) & " .gif":  Next
    ActiveWindow.DisplayGridlines = True
       Application.ScreenUpdating = True
    MsgBox L - 1 & " image" & IIf(L > 2, "s", "") & " created in directory" & vbLf & D, vbInformation, " Done !"
End Sub
Do you like it ? So thanks to click on bottom right Like !
 
So have been playing with this a little more -- it works great when it does work, but it has always just crashed my Excel when trying to do it on a relatively large range (just 200 or so). I'm hoping to do this on up to around 10,000 pictures, so any idea why just 200 is such a problem? Anything I can do about it except get a better computer?? Thanks again!!
 
In case you are using my code,
I never had to use this kind of code with a big workbook
'cause it's not a good idea to store images within a worksheet
as better is to just link images from disk and
as exporting an image from Excel reduces its quality …

Anyway (or code used), maybe issue source is within your data,
it can depend also where the error occurs in code
and what is the exact error message …
 
Back
Top