title: Insert picture in excel macro which takes the file name as reference
body: <p>I have assignments where I need to insert images into excel corresponding with the Style number for that row.
  I am used to inserting picture by picture and then having to resize it which can be time consuming and frustrating.</p>
  
  <p>I put together a vba script from a few different places which does an amazing job. I got the Loop from one place, the CenterMe Sub from another and the IsFile from a third place. All you need to do is put the file paths in the 4th column and it will put a picture perfectly sized in the first column for you.</p>
  
  <p>Only thing is you need to specify a height for the image and then make sure all your boxes are bigger than that height. You also need to specify what the range is. </p>
  
  <p>If anyone can come up with a solution that automatically figures out the height from the cell, and would also figure out the range by looking for the end of the excel, then it would be perfect.
  Here's the code:</p>
  
  <pre><code>' I set RowHeight in the excel to 125 and Picture Height to 100 so it fits nicely
  ' into the box that I want.
  ' That can be changed to suit your needs.
  Sub InsertImageFullName()
  
      Application.ScreenUpdating = False
  
      Dim pic As String ' File path of a picture
      Dim cl As Range
      Dim i As Integer
  
      Set Rng = Range("A2:A117") ' Defining input range
      i = 1
      For Each cl In Rng
  
          pic = cl.Offset(0, 3)  ' Full path of the picture file:
                                 ' Located in the same row, third column from A, i.e. column D
          If IsFile(pic) Then
  
              Set myPicture = ActiveSheet.Pictures.Insert(pic) ' Inserting picture from address in D column
                                                               ' into column A
  
              With myPicture ' Setting picture properties
                  .ShapeRange.LockAspectRatio = msoTrue ' Keep aspect ratio
                  .Height = 100 ' Set your own size
                  .Top = Rows(cl.Row).Top
                  .Left = Columns(cl.Column).Left
                  .Placement = xlMoveAndSize
              End With
              CenterMe ActiveSheet.Shapes(i), cl
              i = i + 1
          End If
  
      Next    ' Looping to the Nth row, defined in:
              ' " Set Rng = Range("A13:A20") "
  
      Set myPicture = Nothing
  
      Application.ScreenUpdating = True
  
  End Sub
  Sub CenterMe(Shp As Shape, OverCells As Range)
  
      With OverCells
          Shp.Left = .Left + ((.Width - Shp.Width) / 2)
          Shp.Top = .Top + ((.Height - Shp.Height) / 2)
      End With
  End Sub
  Function IsFile(ByVal fName As String) As Boolean
  'Returns TRUE if the provided name points to an existing file.
  'Returns FALSE if not existing, or if it's a folder
      On Error Resume Next
      IsFile = ((GetAttr(fName) And vbDirectory) &lt;&gt; vbDirectory)
  End Function
  </code></pre>