PDA

View Full Version : Importing Images Into Excel 2013



compwize
01-14-2014, 06:26 PM
Hello everyone,

I'm new to this forum and have limited knowledge about scripting.

I have a folder located c:\Products\ that contains images
I have an excel sheet that i want to insert images from that folder listed above into column 1
I have the image file name in column two
I did some research and found the following script (you will see it below) that will insert the images into column 1
The script worked fine but it seams to me that the images folder has to be present in the root directory of c:\ for the person to view the images. Its like looking at the reference of the image location.
What i'm asking is, is there a way to insert this images like if you had used the insert image option in excel. So when i email the file to someone when they open it they find the images inserted without to have to send the images folder.

Regards,
Michael

Sub Picture()
Dim picname As String


Dim pasteAt As Integer
Dim lThisRow As Long


lThisRow = 2

Do While (Cells(lThisRow, 2) <> "")


pasteAt = lThisRow
Cells(pasteAt, 1).Select 'This is where picture will be inserted


picname = Cells(lThisRow, 2) 'This is the picture name

present = Dir("C:\Products\" & picname & ".jpg")

If present <> "" Then

ActiveSheet.Pictures.Insert("C:\Products\" & picname & ".jpg").Select 'Path to where pictures are stored
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This resizes the picture
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Selection
'.Left = Range("A6").Left
'.Top = Range("A6").Top
.Left = Cells(pasteAt, 1).Left
.Top = Cells(pasteAt, 1).Top

.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 100#
.ShapeRange.Width = 130#
.ShapeRange.Rotation = 0#
End With




Else
Cells(pasteAt, 1) = "No Picture Found"
End If

lThisRow = lThisRow + 1
Loop

Range("A10").Select
Application.ScreenUpdating = True

Exit Sub

ErrNoPhoto:
MsgBox "Unable to Find Photo" 'Shows message box if picture not found
Exit Sub
Range("B20").Select


End Sub

D_Marcel
01-14-2014, 07:33 PM
Hi Michael, Be welcome to VBAX!
I sorry but I did not understand very well what's your goal. This code inserts the images according to its name in cell two, column two into your sheet, right? Do you send this sheet by e-mail and what happens next? Can you try to give an example?

compwize
01-19-2014, 06:16 PM
Hello,

Ok lets say i have:
1. Folder c:\Products\
2. In the Products i have an image called image.jpg
3. I have the above macro
4. In the spreadsheet im running this macro above i have cell in the second column and i have a value in this cell of "image"
5. if i run the above macro i get an image displayed in the first column first cell which is exactly what i want
6. But if i rename my folder to c:\Products-old
7. I open the same excel file i get an image couldn't be find (or something like that)

So what i realised is the macro will display images on the first column as a reference, it doesn't insert the image in cell itself. What i want is
to insert the image into the cell so when i email the excel sheet i don't have to send the c:\Products folder.

Hope that makes sense :)

D_Marcel
01-19-2014, 06:59 PM
Hello!


Thanks a lot for your explanations, I understand and I could even reproduce your issue.
I never had to build a code to insert images into a sheet, but researching in the Internet, I found the right method to you:

Function AddPicture(Filename As String, LinkToFile As MsoTriState, SaveWithDocument As MsoTriState, Left As Single, Top As Single, Width As Single, Height As Single) As Shape
Membro de Excel.Shapes

Example:
Application.ActiveSheet.Shapes.AddPicture "C:\Test.jpg", False, True, 1, 1, 100, 100

Replace the method ActiveSheet.Pictures.Insert for this one. I tested here deleting permanently the image inserted and it worked perfectly.

Douglas Marcel

compwize
01-20-2014, 05:53 PM
Hello Douglas,

Thanks for your help. I just have to warn you i have no knowledge what so ever in this vb crap. So i'm gonna attach images to show you what i want to do.

I have multiple images in the c:\products, i have an excel with multiple fields.

I want to insert each image in the correct row first column.

please give me the whole code to use.

Please see image11129.

Thanks

D_Marcel
01-21-2014, 06:35 AM
Hi compwize, how are you?

I made a new code to you, let me know if works, okay? I tested here (deleting the images in the folder) and it worked for me.
Copy and paste this whole code into a new module.

Note: In the line: Set Source = Sheets("MySheet") You must replace "MySheet" according to the name of the sheet where the images will be inserted.

Sub Load_Picture()

Dim Entry As Range
Dim WorkArea As Range
Dim Source As Worksheet


With Application
.ScreenUpdating = False
End With


'***Replace "MySheet" for the name of your Worksheet here***
Set Source = Sheets("MySheet")
Set WorkArea = Source.Range(Cells(2, 2), Cells(Cells(Rows.Count, 2).End(xlUp).Row, 2))


For Each Entry In WorkArea
PicturePath = Dir("C:\Products\" & Entry.Value & ".jpg")
If PicturePath <> "" Then
Set Shp = ActiveSheet.Shapes.AddPicture(Filename:="C:\Products\" & Entry.Value & ".jpg" _
, LinkToFile:=False, SaveWithDocument:=True, Left:=Cells(Entry.Row, 1).Left, Top:=Cells(Entry.Row, 1).Top _
, Width:=Cells(Entry.Row, 1).Width, Height:=Cells(Entry.Row, 1).Height)
Shp.Placement = xlMoveAndSize
Shp.ControlFormat.PrintObject = True
Else
Entry.Offset(0, -1).Value = "Picture Not Found"
End If
Next Entry


End Sub

Hope it helps

Douglas

compwize
01-21-2014, 07:34 AM
Douglas,

Thank you very much. This did exactly what i wanted to do.

Thanks a lot.

Regards,
Michael

D_Marcel
01-21-2014, 08:40 AM
You're welcome! :friends:

We just need the moderators now to mark this thread as 'SOLVED'.

With the best regards

Douglas

Timole
04-12-2017, 10:53 PM
Hi Douglas, I wasn't able to get your code to work initially but have now found how to get it to work. So I'm adding this in case it might help others.

The image file names in my Column B, which are to be search for, already have a ".jpg" file extension. So I needed to take that ".jpg" element off the right end of the PicturePath folder string as follows -

Your " PicturePath = Dir("C:\Products\" & Entry.Value & ".jpg") "
I needed to change to " PicturePath = Dir("C:\Products\" & Entry.Value) " in two instances.

I also found a way to change focus from a named sheet to the Active sheet with to make the Module more usable, so instead of -
" '***Replace "MySheet" for the name of your Worksheet here*** Set Source = Sheets("MySheet") "

having
" Set Source = ActiveSheet "

Please can anyone help with a way of altering the dimensions of the imported image within the remainder of the " Set Shp ActiveSheet.Shapes.AddPicture( " expression? The code as it worked for me brought the images in at the row height and column width of the cells in Columns 1 (A). 2013 ActiveSheet.Shapes.AddPicture is supposed to provide a way of specifying dimensions within that expression from what I read.

I shall appreciate any advice that may assist. Thanks.
Regards, Tim