'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:
- Take the current file path
- Insert image into the fixed cell (B29)
- Set image height to match row height
- Lock aspect ratio so that the width is adjusted based on the row height
- Continue with existing macro to PDF
- 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 |
|---|
