Saving pictures from excel

[GeorgeTsomaia]

Hi,

I renamed images in excel, but when I extract them the names change like image01.
how can I extract them without losing the name?

George.

 

[Marc L]

Hi !

So do not forget to name images when you import them …
​

 

[GeorgeTsomaia]

Hi,

Sorry but I don't understand what you wanted to say. In excel I renamed shapes with specific names. Now I need to extract images and them to have the same names which I asigned them.

George

 

[Marc L]

How do you extract them ?​

 

[GeorgeTsomaia]

By changing the type of the file with zip or html.

 

[Marc L]

Please avoid to quote each time the just previous post !

Unclear … Can you elaborate ?
​

 

[GeorgeTsomaia]

I've named shapes in column B using a VBA code. Now I need to have those pictures on desktop and their names must be the same as I named them. I can't think of a solution.

 

[Marc L]

Just follow logic :
when you extract an image, apply its name where it stands …

If the image within Excel was named with the correct name,
I can't foresee your issue …
​

 

[GeorgeTsomaia]

I can't understand how to do it. Is there some kind of vba code or something?


▬▬▬▬▬▬▬▬▬ Mod edit : thread moved to appropriate forum !

​

 

[Marc L]

Maybe, it depends on logic to follow …​

 

[GeorgeTsomaia]

hmm, I'm new to this and can't do a lot of things.

 

[Marc L]

You can also activate the Macro Recorder and operate manually :
you will get a base code …
​

 

[YasserKhalil]

Hello
Have a look at this link
http://www.excelhowto.com/how-to-quickly-extract-pictures-from-an-excel-file/

 

[GeorgeTsomaia]

That is the way I'm doing it, the extracted images names aren't the same as the names I've set for them.

 

[YasserKhalil]

Can you post sample of your workbook to test a code I have on it?

 

[GeorgeTsomaia]

Names are in column A, images in column B

 

[YasserKhalil]

Try this code

Sub Test()
    Dim shp        As Picture
    Dim chrt        As ChartObject
    Dim n          As Long

    Application.ScreenUpdating = False
        On Error GoTo Finish
   
        For Each shp In ActiveSheet.Pictures
            n = n + 1
            Charts.Add.Location Where:=xlLocationAsObject, Name:=ActiveSheet.Name
            Set chrt = ActiveSheet.ChartObjects(1)
            chrt.Border.LineStyle = 0
            chrt.Width = shp.Width
            chrt.Height = shp.Height
            shp.Copy
           
            With chrt.Chart
                .ChartArea.Select
                .Paste
            End With
           
            chrt.Chart.Export Filename:=Cells(n + 2, 1) & ".jpg", FilterName:="jpg"
            chrt.Delete
        Next shp
    Application.ScreenUpdating = True
    Exit Sub
Finish:
End Sub

 

[GeorgeTsomaia]

Where will this save the images?

 

[YasserKhalil]

To the default Save location
You can change the path from this line

Filename:=Cells(n + 2, 1) & ".jpg"

Add the path before Cells .. Like that "C:\Temp\" & Cells .....

 

[GeorgeTsomaia]

It doesn't work :/ but thank you for your time

 

[YasserKhalil]

I have tested it and it worked for me

Sub Test()
    Dim shp        As Picture
    Dim chrt        As ChartObject
    Dim n          As Long

    Application.ScreenUpdating = False
        On Error GoTo Finish
 
        For Each shp In ActiveSheet.Pictures
            n = n + 1
            Charts.Add.Location Where:=xlLocationAsObject, Name:=ActiveSheet.Name
            Set chrt = ActiveSheet.ChartObjects(1)
            chrt.Border.LineStyle = 0
            chrt.Width = shp.Width
            chrt.Height = shp.Height
            shp.Copy
         
            With chrt.Chart
                .ChartArea.Select
                .Paste
            End With
         
            chrt.Chart.Export Filename:="C:\Temp\" & Cells(n + 2, 1) & ".jpg", FilterName:="jpg"
            chrt.Delete
        Next shp
    Application.ScreenUpdating = True
    Exit Sub
Finish:
End Sub

Create a folder on C: and name it "Temp"
Or change the path to suit your needs

 

[GeorgeTsomaia]

wow, it did work, thank you very much.

 

[YasserKhalil]

You're welcome. Glad I can offer some help