Inserting images and resizing on different sheet

[bronkista]

Hi guys,

I have tried some of the stuff I saw here but it isn't really working for me and I hope you can help.
Basically I have a product catalogue sheet where there's a list of items and I would like to import images from my folder depending on the item ID.

-There are 2 tabs on my file
-"Item Mapping" sheet contains data to be relevant to the template in "Sheet1"
-Column F in Item Mapping sheet contains the filename of the image to be imported
-Sheet1 tab contains a template for images, the placeholders for these images are merged cells
-I would like to import and resize the images to fit these placeholders.

Your help is much appreciated!

 

[Dan_W]

Hi Bronkista

Which part are you stuck on? Do you have any code that you've tried, and need help working through? Also, out of curiosity, why are the image placeholders merged cells?

Dan

 

[bronkista]

Hi Bronkista

Which part are you stuck on? Do you have any code that you've tried, and need help working through? Also, out of curiosity, why are the image placeholders merged cells?

Dan

This was the code I found searching the forums, however it's only able to place images on the same sheet and on the B column.
I'm looking for something that will be able to place the images on a different tab and on specific cells and unfortunately, I don't know how to do that yet.

Sub InsertPicsr1()
Dim fPath As String, fName As String
Dim r As Range, rng As Range
Dim shpPic As Shape

Application.ScreenUpdating = False
fPath = "C:\Temp"
Set rng = Range("D2:D" & Cells(Rows.Count, 4).End(xlUp).Row)
For Each r In rng
    On Error GoTo errHandler
    If r.Value <> "" Then
        Set shpPic = ActiveSheet.Shapes.AddPicture(Filename:=fPath & r.Value & ".jpg", linktofile:=msoFalse, _
            savewithdocument:=msoTrue, Left:=Cells(r.Row, 2).Left, Top:=Cells(r.Row, 2).Top, Width:=-1, Height:=-1)
        With shpPic
            .LockAspectRatio = msoTrue
            If .Width > Columns(2).Width Then .Width = Columns(2).Width
            Rows(r.Row).RowHeight = .Height
        End With
    End If
errHandler:
If Err.Number <> 0 Then
    Debug.Print Err.Number & ", " & Err.Description & ", " & r.Value
    On Error GoTo -1
End If
Next r
Application.ScreenUpdating = True
End Sub

Here's the template layout on the Sheet1 tab:

Here's from the "Item Mapping" tab

 

[bronkista]

Bump. Anyone?

 

[Dan_W]

Hi Bronkista

There are quite a few problems with your code - I know that what you need is a solution, and not someone telling you what is wrong with it, but it is worth identifying for you/others some of the issues in case anyone with a similar problem tries to use this code in future.

Some immediate observations:

1. File path - The code seeks to load JPG pictures from "C:\Temp" folder, but the concatenation of the file path will throw up an error.

• For starters, the code pulls the image filename from column D, and not F:

Set rng = Range("D2:D" & Cells(Rows.Count, 4).End(xlUp).Row)

​

• 
  [*=1]The code does not add a "" to separate the folder (C:\Temp) from the intended filename. Accordingly, based on the current code and on the screen captures in your most recent post, this will result in the loop produce every file path as being:

C:\TempDesc.jpg

• Even if the code did properly point to column F, the code adds a ".jpg" extension to the file path, which would result in "105173.jpg.jpg", "105174.jpg.jpg", and so on.

• 
  [*=1]I would suggest replacing the relevant lines with the following:

​

fPath = "C:\Temp\"

Set rng = Range("F2:F" & Cells(Rows.Count, 4).End(xlUp).Row)

Set shpPic = ActiveSheet.Shapes.AddPicture(Filename:=fPath & r.Value, linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=Cells(r.Row, 2).Left, Top:=Cells(r.Row, 2).Top, Width:=-1, Height:=-1)

NOTE: The above code still will not work for a few reasons, but I am just setting out the issues in stages. Critically, the code above still situates the images on the ActiveSheet (and not Sheet1), does not resize the image, and places the images in consecutive rows (and not merged cells).


2. File name location - The code looks first to cell F2 for the image filename. Is it correct that the first image filename is in row 2?

3. Image size - The code presumes that the images are all the same size and does not purport to resize them. I note from the the title of your post that you want to resize the images; if the images are all resized to the size of the merged cell, will that work for your purposes? (i.e., are all the images the same dimension?)

I don't have time to solve it today, but wanted to get back to you to let you know you haven't been forgotten.

Dan

 

[bronkista]

Yes, I have actually done what you pointed out. I just pasted the "default" code that I saw here in the forum.
Unfortunately, I'm unable to modify it further to get what I'm looking for.