Automatically insert multiple pictures in excel under 1 ref

Closed
Mpollet Posts 1 Registration date Friday August 1, 2014 Status Member Last seen August 4, 2014 - Aug 1, 2014 at 10:49 AM
TrowaD Posts 2913 Registration date Sunday September 12, 2010 Status Moderator Last seen November 21, 2022 - Aug 5, 2014 at 11:21 AM
Dear all,

I hope to find some help here as I would really like to find an easier way than just insert each picture manually.
I am not a pro in VBA but I usually find my way through the forums. My technique has its limits and here I am asking for some support :)

I have a folder on my desktop with pictures such as (there are hundreds)
"1234567front.jpg"
"1234567back.jpg"
"1765432front.jpg"
"1765432back.jpg"
"1765432back2.jpg"

1234567 or 1765432 are reference codes for a specific product (always 7 numbers)
I would need to import all these pictures in an excel file right next to the reference code of the product.
One product has usually from 1 to 5 pictures.

Ideally, I have in A1 the reference code: "1234567", then the 2 pictures containing" this number should come in B1 and C1
A2: "1765432", I would like to have in B2, C2, D2, the 3 pictures containing "1765432" in the picture's name .

I already have the code to import one picture if it's name exactly as the reference code but as I have more than 1 picture and that every picture from a folder has to have a different name, it is a problem...

(An alternative still suitable system would be to import a picture and to extract the name of this picture next to the picture cell)

Here is what I have for the moment to paste the picture in column A based on the values in column B

Sub Load_Picture()

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

With Application
.ScreenUpdating = False
End With

Set Source = Sheets("Sheet5")
Set WorkArea = Source.Range(Cells(2, 2), Cells(Cells(Rows.Count, 2).End(xlUp).Row, 2))

For Each Entry In WorkArea
PicturePath = Dir("C:\Users\mpollet\Desktop\New folder" & Entry.Value & ".jpg")
If PicturePath <> "" Then
Set Shp = ActiveSheet.Shapes.AddPicture(Filename:="C:\Users\mpollet\Desktop\New folder" & 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

Thank you very much for your help.

If you know different ways to handle my problem, I am fine with it, as long as I get those damn picture in my excel with the product code somehow linked to the pictures :)

Manu

1 reply

TrowaD Posts 2913 Registration date Sunday September 12, 2010 Status Moderator Last seen November 21, 2022 541
Aug 5, 2014 at 11:21 AM
Hi Manu,

A simple solution could be (to be honest can't think of a better one) to put the file names already in the cells and then increase your WorkArea.

So if A1 = 1234567 , then
B1: = A1 & "front.jpg"
C1: = A1 & "front2.jpg"
D1: = A1 & "front3.jpg"
E1: = A1 & "front4.jpg"
F1: = A1 & "front5.jpg"
G1: = A1 & "back.jpg"
H1: = A1 & "back2.jpg"
etc..

Hope this helps.

Best regards,
Trowa
0