export images from excel to folder with Id number as a name of picture

[arshab]

I have and excel file. in sheet1 column A is serial number column B is ID Number, Column C is image of a person, and column D is Name, now I want to export photograph to C/temp in jpg format, in the place of name i need there ID number wich is in column B, in vba, there are more then 1000 rows , pls help

 

[John_w]

Welcome to MrExcel forums. Try this macro:

Public Sub Save_Pictures()

    Dim saveInFolder As String
    Dim shp As Shape
    
    saveInFolder = "C:\Temp\"
    If Right(saveInFolder, 1) <> "\" Then saveInFolder = saveInFolder & "\"
       
    For Each shp In ActiveSheet.Shapes
        If shp.Type = msoPicture And shp.TopLeftCell.Column = 3 Then
            Save_Object_As_Picture shp, saveInFolder & shp.TopLeftCell.Offset(0, -1).Value & ".jpg"
        End If
    Next
    
End Sub


Private Sub Save_Object_As_Picture(saveObject As Object, imageFileName As String, Optional scaleFactor As Single)

    'Save a picture of an object as a JPG/JPEG/GIF/PNG file
    
    'Parameters
    'saveObject     - any object in the CopyPicture method's 'Applies To' list, for example a Range or Shape
    'imageFileName  - the .gif, .jpg, or .png file name (including folder path if required) the picture will be saved as
    'scaleFactor    - the factor by which the width and height will be scaled in the saved image
    
    Dim temporaryChart As ChartObject
    
    Application.ScreenUpdating = False
        
    saveObject.CopyPicture xlScreen, xlPicture

    Set temporaryChart = ActiveSheet.ChartObjects.Add(0, 0, saveObject.Width, saveObject.Height)
    
    With temporaryChart
        .Activate                               'Required, otherwise image is blank
        DoEvents
        .Border.LineStyle = xlLineStyleNone     'No border
        .Chart.Paste
        If scaleFactor > 0 Then
            .Width = .Width * scaleFactor
            .Height = .Height * scaleFactor
        End If
        .Chart.Export imageFileName
        .Delete
    End With
    
    Application.ScreenUpdating = True
    
    Set temporaryChart = Nothing
    
End Sub

 

[arshab]

Thanks Bro! But unfortunately this is not working, When i press f8 i can see , it goes to
"If shp.Type = msoPicture And shp.TopLeftCell.Column = 3 Then"
then it goes directly to "End if"

I have copied images from some website,
while copying images from website to excel, 2 white boxes also copied, and pasted above one of my photograph in column 3,
those boxes were exported to "C:\Temp" , but no other images exported to C:\Temp\

 

[John_w]

The And part of the If was to ensure it only processed pictures which start in column C. If yours don't, try changing the If statement to:

        If shp.Type = msoPicture Then

 

[arshab]

how would i know If shp.Type = msoPicture?? or something else??

 

[arshab]

edit alt text showed me that images format are like this
C:\Users\shabb\Dropbox\My_EXcel_programs\copyfromits\copyfromits\page1_files\GetImageForEMail.aspx
C:\Users\shabb\Dropbox\My_EXcel_programs\copyfromits\copyfromits\page1_files\GetImageForEMail(1).aspx
C:\Users\shabb\Dropbox\My_EXcel_programs\copyfromits\copyfromits\page1_files\GetImageForEMail(2).aspx
I am not a geek dont know weather these images are a link or saved images
kindly help sending these images to folder

 

[John_w]

how would i know If shp.Type = msoPicture?? or something else??

Step through the code by pressing the F8 key in the VBA editor and hover over shp.Type when it gets to that line. shp.Type is 13 for a picture.

edit alt text showed me that images format are like this
C:\Users\shabb\Dropbox\My_EXcel_programs\copyfromits\copyfromits\page1_files\GetImageForEMail.aspx
C:\Users\shabb\Dropbox\My_EXcel_programs\copyfromits\copyfromits\page1_files\GetImageForEMail(1).aspx
C:\Users\shabb\Dropbox\My_EXcel_programs\copyfromits\copyfromits\page1_files\GetImageForEMail(2).aspx
I am not a geek dont know weather these images are a link or saved images
kindly help sending these images to folder

Alt text is the optional alternative text which is displayed if Excel (or a browser) can't display the image.

.aspx is a web page, not an image.

 

[arshab]

Thanx bro for halping me, as i told u i m not a geek, but fortunately i found the solution for what i am looking for, using your code,
For that i have to select one pic, cut it and paste it as paste spacial "picture (U)" then run your code, and bingo, i found the pic in my temp folder with id number as a name of pic, but i have more then 1000 pics, can you write a script which selects picture one by one cut it and paste it again as paste spacial "picture (U)"

 

[John_w]

Record a macro whilst you do the steps and post the generated code here and I'll see if I can incorporate it into my code.

 

[arshab]

Sub Macro3()
' Macro3 Macro
ActiveSheet.Shapes.Range(Array("gvSearch_ctl03_imgPerson")).Select
Selection.Cut
ActiveSheet.Pictures.Paste.Select
Selection.ShapeRange.IncrementLeft 9.8958267717
Selection.ShapeRange.IncrementTop 69.7916535433
End Sub