Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

How to export embedded pictures to a file - Excel 2010

Posted on 2011-10-18
9
Medium Priority
?
173 Views
Last Modified: 2012-05-12
I have an excel spreadsheet that has the following format:
<Actual Picture>,Name,PartNumber,Qty

I would like to export the pictures to a file with its name as the partnumber so I can import them into another program.  How would I go about doing this.  I don't have any Macro/VBA experience.
0
Comment
Question by:bmsjeff
8 Comments
 
LVL 42

Expert Comment

by:dlmille
ID: 36990298
Here's a solution I worked on in August that's right up your alley, I think:

http:/Q_27235386.html

Take a look and let me know if you need further assistance (a small mockup file with a few pics would be warranted).

Cheers,

Dave
0
 
LVL 14

Author Comment

by:bmsjeff
ID: 36990468
I came up with another one that does what I want, less one thing.
I have some rows that have multiple item numbers with a single picture.  i.e.
A10,pic10,item10
A11,pic11,item11
A12,pic11,item12
A13,pic11,item13
A14,pic14,item14
A15,pic15,item15
(A11-13 has a single picture that fills the 3 rows.  the formula below will export A11, but A12 and A13 are not.  A14 and 15 export fine.)  
Is there a way to have it handle this?

Here is the code:

Sub export()
Dim picture_object As Shape
Dim picture_height As Double
Dim picture_with As Double
Dim filename As String
Dim temporary_object As Chart
   
    For Each picture_object In Shapes
        filename = Cells(picture_object.TopLeftCell.Row, picture_object.TopLeftCell.Column + 2)
        picture_height = picture_object.Height
        picture_width = picture_object.Width
        picture_object.ScaleHeight 1, msoTrue
        picture_object.ScaleWidth 1, msoTrue
        picture_object.Copy
        Set temporary_object = ChartObjects.Add(1, 1, picture_object.Width, picture_object.Height).Chart
        temporary_object.Paste
        temporary_object.export "D:\Pictures\" & filename & ".jpg"
        temporary_object.Parent.Delete
        picture_object.LockAspectRatio = msoFalse
        picture_object.Height = picture_height
        picture_object.Width = picture_width
    Next picture_object
   
End Sub

0
 
LVL 42

Expert Comment

by:dlmille
ID: 36990512
Probably because they sit in the same place, and you're giving them the same name.

Try this:
Sub export()
Dim picture_object As Shape
Dim picture_height As Double
Dim picture_with As Double
Dim filename As String
Dim temporary_object As Chart
Dim myDict As Object
Dim fileCtr As Long
Dim bExists As Boolean

    Set myDict = CreateObject("Scripting.Dictionary")
    
    For Each picture_object In Shapes
        filename = Cells(picture_object.TopLeftCell.Row, picture_object.TopLeftCell.Column + 2)
        fileCtr = 0
        If myDict.Exists(filename) Then
            Do
                fileCtr = fileCtr + 1
                bExists = myDict.Exists(filename & fileCtr)
            Loop While bExists
        End If
        
        filename = IIf(fileCtr = 0, filename, filename & fileCtr)
        myDict.Add filename
        
        picture_height = picture_object.Height
        picture_width = picture_object.Width
        picture_object.ScaleHeight 1, msoTrue
        picture_object.ScaleWidth 1, msoTrue
        picture_object.Copy
        Set temporary_object = ChartObjects.Add(1, 1, picture_object.Width, picture_object.Height).Chart
        temporary_object.Paste
        temporary_object.export "D:\Pictures\" & filename & ".jpg"
        temporary_object.Parent.Delete
        picture_object.LockAspectRatio = msoFalse
        picture_object.Height = picture_height
        picture_object.Width = picture_width
    Next picture_object
    
    myDict.RemoveAll
    Set myDict = Nothing
End Sub

Open in new window


I added a dictionary (which only allows unique entries in the collection).  If the filename exists, an incrementer is tagged onto the filename, until the filename & counter doesn't exists, then its added to the dictionary and that's the filename to use for saving.

You adapt very well for someone who hasn't done much VBA!

Cheers,

Dave
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 14

Author Comment

by:bmsjeff
ID: 36992237
Thanks Dave.

When I run that script I get:
Run-time error 450
Wrong number of arguments or invalid property assignment
0
 
LVL 42

Accepted Solution

by:
dlmille earned 2000 total points
ID: 36994190
I'm not sure that was the only thing not quite right with the code.  I built a test wkb (its useful to post a mock up when you need help like this - so you get your solutions faster), made the parameter change to the related error you posted, and modified the logic in a minor way, so it would work.

here's the code:
Sub export()
Dim picture_object As Shape
Dim picture_height As Double
Dim picture_with As Double
Dim filename As String
Dim temporary_object As Chart
Dim myDict As Object, dictIdx As Long
Dim fileCtr As Long
Dim bExists As Boolean

    Set myDict = CreateObject("Scripting.Dictionary")
    dictIdx = 1
    
    For Each picture_object In ActiveSheet.Shapes
        filename = Cells(picture_object.TopLeftCell.Row, picture_object.TopLeftCell.Column + 2)
        If filename <> "" Then
            fileCtr = 0
            If myDict.Exists(filename) Then
                Do
                    fileCtr = fileCtr + 1
                    bExists = myDict.Exists(filename & fileCtr)
                Loop While bExists
            End If
            
            filename = IIf(fileCtr = 0, filename, filename & fileCtr)
            myDict.Add filename, dictIdx
            
            picture_height = picture_object.Height
            picture_width = picture_object.Width
            picture_object.ScaleHeight 1, msoTrue
            picture_object.ScaleWidth 1, msoTrue
            picture_object.Copy
            Set temporary_object = ActiveSheet.ChartObjects.Add(1, 1, picture_object.Width, picture_object.Height).Chart
            temporary_object.Paste
            temporary_object.export "D:\Pictures\" & filename & ".jpg"
            temporary_object.Parent.Delete
            picture_object.LockAspectRatio = msoFalse
            picture_object.Height = picture_height
            picture_object.Width = picture_width
        Else
            MsgBox "No Picture found at Row: " & picture_object.TopLeftCell.Row & ", Col: " & picture_object.TopLeftCell.Column + 2, vbOKOnly
        End If
    Next picture_object
    
    myDict.RemoveAll
    Set myDict = Nothing
End Sub

Open in new window


see attached,

Cheers,

Dave
savePics-r1.xls
0
 
LVL 3

Expert Comment

by:Davy2270
ID: 36998751
You should set a reference to the Microsoft Scripting Runtime.

How to:
Open your VBA editor (press Alt + F11 with your workbook activated)
Click Tools - References
Then check Microsoft Scripting Runtime .

Your code should run fine now.

Regards,
Davy
0
 
LVL 42

Expert Comment

by:dlmille
ID: 37205696
@bmsjeff - would you kindly advise the source of your original export() code?  I'm writing an article and using the results of what we did, and want to cite an original source, if I can.

Thanks,

Dave
0
 
LVL 50
ID: 37419376
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

581 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question