Forum Discussion

MrGeekyBro's avatar
MrGeekyBro
Copper Contributor
Nov 03, 2023

Help with Macro to insert pictures from a folder down an excel column.

Alright folks, I could use some help trying to create a macro that can insert a slew of pictures down a column in Excel based off of the picture file names down another corresponding column. Im trying to create multiple reports with pictures within a short amount of time, and the only way I think I can pull it off is if I dont have to manually copy and paste the picture of every single item. 

 

I only have this vba so far that printed out the picture of the file name called, but I basically need this exact process to go down the entire rest of the column and pull the picture based off the picture file name down the column:

 

Here:

 

Sub InsertPicture()
ActiveSheet.Shapes.AddPicture _
Filename:="C:\Users\mrell\Pictures\como.png", _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=ActiveCell.Left, _
Top:=ActiveCell.Top, _
Width:=-1, Height:=-1
End Sub

Sub y()

End Sub
Sub x()

End Sub

 

The picture pulled but it was huge. Id need it to hopefully be wrapped into the cell/within the cell if possible.Original file, I want to run a vba that will pull the photos and insert them down column c, based off of the file names in column b).So basically this would be the final result. A slew of photos would be going down column G, preferably within their own boxesIf possible, Id prefer them to not have lock aspect ratio clicked/formatted, and to move and size with the cells?

 

So does anyone think they can basically, take the insert photo idea from above:

-But have the vba go completely down the column (lets say column C), and enters into column C....the photo that has the file name next door (same row) in Column B?

 

Could anyone possibly help direct me with this?

  • MrGeekyBro 

    The file names in your worksheet don't include the extension. I used .png in the code, as in your sample code.

    Sub InsertPictures()
        ' Folder path - MUST end in backslash \
        Const strFolder = "C:\Users\javog\Pictures\Diversen\"
        Dim strFile As String
        Dim rng As Range
        Dim cel As Range
        Application.ScreenUpdating = False
        Set rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
        For Each cel In rng
            strFile = cel.Value & ".png"
            ActiveSheet.Shapes.AddPicture _
                Filename:=strFolder & strFile, _
                LinkToFile:=False, _
                SaveWithDocument:=True, _
                Left:=cel.Offset(0, 1).Left, _
                Top:=cel.Offset(0, 1).Top, _
                Width:=-1, _
                Height:=-1
        Next cel
        Application.ScreenUpdating = True
    End Sub

Resources