Thread: How to import picture file from folder using cell value?

Hello kaypat,

This macro should get you started. This will import the file using the name in the active cell. If the file is found in the specified folder, it will be inserted with the upper left corner of the picture in the cell to right of the active cell. The macro does not size the picture. It is inserted at full size. Als, the macro expects the picture to have a jpg extension. If your pictures have a different extension, it will need to be changed in the macro code.

Sub ImportPicture()

    Dim Filepath As String
    Dim Pic As Object
    
            Filepath = "C:\Documents and Settings\User\Desktop\Pictures\"
            
            If Dir(Filepath & ActiveCell & ".jpg") = "" Then Exit Sub
            
            Set Pic = ActiveSheet.Pictures.Insert(Filepath & ActiveCell)
            
            With Pic
                .Left = ActiveCell.Offset(0, 1).Left
                .Top = ActiveCell.Offset(0, 1).Top
            End With
            
End Sub

Hello kaypat,

I used ActiveCell only as example. If you have a specific cell in mind, say "A1" with the file path and name, then the code would be as below. This will place the upper left corner of the picture in cell "B1".

Sub ImportPicture()

    Dim Filepath As String
    Dim Pic As Object
    
            Filepath = "C:\Documents and Settings\User\Desktop\Pictures\"
            
            If Dir(Filepath & ActiveCell & ".jpg") = "" Then Exit Sub
            
            Set Pic = ActiveSheet.Pictures.Insert(Filepath & ActiveCell)
            
            With Pic
                .Left = Range("A1").Offset(0, 1).Left
                .Top = Range("A1").Offset(0, 1).Top
            End With
            
End Sub

Hello kaypat,

It appears that the Picture class has been dropped from Excel starting with Excel 2007. Here is another way that should work.

Sub ImportPicture()

    Dim Filename As String
    Dim Filepath As String
    Dim Pic As Shape
            
           Filepath = "C:\Documents and Settings\User\Desktop\Pictures\" 
           Filename = Filepath & ActiveCell & ".jpg"
            
            If Dir(Filename) = "" Then Exit Sub
            
            With Range("A1").Offset(0, 1)
                Set Pic = ActiveSheet.Shapes.AddPicture(Filename, msoFalse, msoTrue, .Left, .Top, -1, -1)
            End With
            
End Sub

Hello kaypat,

Yes, yes, and yes. Would you like me change the macro to do this? My guess is yes.

Hello kaypat,

Here is the revised macro to copy the image from a file into a range of cells. The previous picture will be deleted before the new picture is added.

The attached workbook will import the picture using the contents of cell "A1" on "Sheet1" as the file name. The macro assumes all files are a jpg type so do not add ".jpg" to the file name. The picture range is cells C2 to E14. The picture will be sized automatically to fit the cells in the range.

There are now two macros. One is the Worksheet_Change event for "Sheet1" which checks that you entered a value into cell and calls the import picture macro. The import picture macro then adds the picture from the file to the worksheet and resizes it to fit the range.

Worksheet_Change Event Macro Code

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Cells.Count > 1 Then Exit Sub   
    If Target.Address <> "$A$1" Then Exit Sub
    
        Call ImportPicture(Target.Value)
    
End Sub

Import Picture To Range Macro Code

Sub ImportPicture(ByVal Filename As String)

    Dim Filepath As String
    Dim Pic As Shape
    Dim PicName As String
    Dim PicRange As Range
            
           Set PicRange = ActiveSheet.Range("C2:E14")
           
           PicName = PicRange.Cells(1, 1)
           If PicName <> "" Then ActiveSheet.Shapes(PicName).Delete: PicRange.Cells(1, 1) = ""
           
           Filepath = "C:\Documents and Settings\User\Desktop\Pictures\"
           Filename = Filepath & ActiveCell & ".jpg"
            
            If Dir(Filename) = "" Then Exit Sub
            
            With PicRange
                Set Pic = ActiveSheet.Shapes.AddPicture(Filename, msoFalse, msoTrue, .Left, .Top, .Columns.Width, .Rows.Height)
                PicRange.Cells(1, 1) = Pic.Name
            End With
            
End Sub