macro: insert muliple images and resize into given cells

[marco83]

Hi All,
please help complete newbie how to create and instal macro in excel.



The file is just a pricelist that will be updated weekly. There is already formula working on it and now needs only insert resized images. Assume images are stored C:\images. Column A is unique code of product 123456. Column N is called Image and needs automation insert files from given path matching code from A column for each of 1000 records. Assume files on disk are 800x600 and needs to be resized and fit cell 70x22 (Row height x column widht). Files will be named 123456 etc.
Need macro to be visible only on my machine, not to be saved in workbook and send further.



for many of you probably simple, for me rocker science. Thank you for help in advance

[Kenneth Hobson]

Welcome to the forum!

Automatic would mean that the macros are in the workbook and can act due to some event. If you want to keep the macro in your open workbook or personal workbook, then it would be run manually.

Since the height and widths have different ratios, did you really want to distort the image and make it fit? If you don't want to distort it, one would just set one of the dimensions.

As for the image file's name, what is the file extension? gif, jpg, bmp, png, etc.

It also makes a difference in coding if an image could already be in the image's cell. While one could overlay with another image, that is generally not done. So, more code is needed to avoid that problem.

Here is a simple example that may suit with a tweak or two. Change the offset from 1 to the offset you want, 13.

Sub Main()
  Dim pic As Shape, r As Range, fPath As String

  fPath = "x:\pics\"
  
  On Error Resume Next
  For Each r In Range("A2", Range("A" & Rows.Count).End(xlUp))
    Set pic = ActiveSheet.Shapes.AddPicture(Filename:=fPath & r.Value2 & ".jpg", _
      LinkToFile:=msoFalse, SaveWithDocument:=msoCTrue, _
      Left:=r.Offset(, 1).Left, Top:=r.Offset(, 1).Top, _
      Width:=r.Width, Height:=r.RowHeight)
    'Debug.Print pic.Name
  Next r
End Sub