'Adding an image to a worksheet during a for loop

I have a VBA macro which pulls data from a basic table into a report template (worksheet) and PDFs the data then moves to the next row.

The macro is working at present but I need to add an image to each report. Each image will have a pre-defined file path which is in the table of input data. I have trailed various ways to add an image successfully from a given file path but it appears doing this during the 'For loop' they don't provide the same desired result.

Ideal process:

  1. Take the current file path
  2. Insert image into the fixed cell (B29)
  3. Set image height to match row height
  4. Lock aspect ratio so that the width is adjusted based on the row height
  5. Continue with existing macro to PDF
  6. Loop to next iteration
Private Sub Print_to_PDF_Click()


Dim filelocation As String
Dim filename As String
Dim full_path As String
Dim max As Double
Dim i As Integer
Dim image_file_path As String
Dim location_image As Picture
Dim image_cell_ID As Range


' Set max number for PDF iterations
max = Application.WorksheetFunction.max(Worksheets("structure data").Range("a:a"))
'i = 1
Worksheets("Report").Activate


'Location where PDF is saved
filelocation = Worksheets("project data").Range("PDFDirectory").Value

'Worksheets("Report").Range("Row_LookUp").Value = 1
    
'loop to be repeated for each entry
For i = 1 To max

    ' Set the row lookup to the new value
    'Set Worksheets("Report").Range("Row_LookUp").Value = i
    Worksheets("Report").Range("Row_LookUp").Value = i
       
    'Name of PDF file based on the current row
    filename = Worksheets("Report").Range("Document_ref")
    
    'Construct the full file path
    full_path = filelocation & "/" & filename & ".pdf"
    
    'Assign file path from cell to variable
    image_file_path = Worksheets("Report").Range("Image_file_path")
    
    'Identify which cell the location image will be placed in
    Set image_cell_ID = Worksheets("Report").Range("B29")
    
        'This section imports the existing location image into the right cell
        Set location_image = Worksheets("report").Pictures.Insert(image_file_path)
        
        With location_image
            .Left = image_cell_ID.Left
            .Top = image_cell_ID.Top
            .Height = image_cell_ID.RowHeight
            .Placement = xlMoveAndSize
        End With
       
    
    'Select the area to be PDF'd
        Worksheets("Report").Range("A1:M62").Select
        
        'PDF export
        Selection.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        filename:=full_path, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenafterPublish:=False

Next i

End Sub

Any help is much appreciated!



Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source