How to insert image (.jpg, .png) from folder based on name file in cell to specific sheet with VBA.

[mesharp]

I have problem about VBA, I searched an internet and no one can achieved my problem using VBA.

images are several type such as .png , .jpg and different size.
I want using VBA to only one click the button and import the image from my folder to excel by multiple specific name and multiple worksheets.
and resize the image to be I specified.

Example
The folder link which contains images is = cell A1

Picture	File name	Destination sheet
1	001.png	sheet1
2	002.jpg	sheet2
3	003.png	sheet3

 

[John_w]

Welcome to MrExcel forums.

The folder link which contains images is = cell A1

In the macro below, the folder path to the images is in cell D1, with the cell values shown in your post in columns A:C on a sheet named "Images".

resize the image to be I specified.

The width and height of all images is specified in this part of the code:

    Const pictureWidth = 200
    Const pictureHeight = 300

I want using VBA to only one click the button

Assign this macro to the button.

Public Sub Insert_Images_To_Sheets()

    Dim folder As String, imageFile As String
    Dim lastRow As Long, r As Long
    Dim pic As Shape
    
    Const pictureWidth = 200
    Const pictureHeight = 300
    
    With Worksheets("Images")
        folder = .Range("D1").Value
        If Right(folder, 1) <> "\" Then folder = folder & "\"
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For r = 2 To lastRow
            imageFile = .Cells(r, "B").Value
            With Worksheets(.Cells(r, "C").Value).Range("A1")
                Set pic = .Worksheet.Shapes.AddPicture(Filename:=folder & imageFile, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
                                                       Left:=.Left, Top:=.Top, Width:=pictureWidth, Height:=pictureHeight)
            End With
        Next
    End With
    
End Sub

 

[mesharp]

Welcome to MrExcel forums.


In the macro below, the folder path to the images is in cell D1, with the cell values shown in your post in columns A:C on a sheet named "Images".


The width and height of all images is specified in this part of the code:

    Const pictureWidth = 200
    Const pictureHeight = 300

Assign this macro to the button.

Public Sub Insert_Images_To_Sheets()

    Dim folder As String, imageFile As String
    Dim lastRow As Long, r As Long
    Dim pic As Shape
   
    Const pictureWidth = 200
    Const pictureHeight = 300
   
    With Worksheets("Images")
        folder = .Range("D1").Value
        If Right(folder, 1) <> "\" Then folder = folder & "\"
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For r = 2 To lastRow
            imageFile = .Cells(r, "B").Value
            With Worksheets(.Cells(r, "C").Value).Range("A1")
                Set pic = .Worksheet.Shapes.AddPicture(Filename:=folder & imageFile, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
                                                       Left:=.Left, Top:=.Top, Width:=pictureWidth, Height:=pictureHeight)
            End With
        Next
    End With
   
End Sub

Dear John_w

my apologies for the delay in responding and thank you for your answer.
I have question about your code.

If my file name is 001,002 and 003
(.png, .jpeg = the type of picture , not the file name).
How can I insert the picture with several type of picture?

This is the code I'm attempting to insert the several type of picture

Sub AddPictures()
    Dim picName As String
    Dim picPath As String
    Dim pic As Picture
    Dim cell As Range
    Dim Link As String
    
        'Loop through all cells in range A1:A5
        For Each cell In Range("A1:A5")
    
        'Get the name of the picture from the cell
        picName = cell.Value
        
        Link = Range("B1")
        
        'Get the path of the picture based on the file type
        If InStr(picName, ".jpg") > 0 Then
            picPath = Link & "\" & picName
        ElseIf InStr(picName, ".png") > 0 Then
            picPath = Link & "\" & picName
        ElseIf InStr(picName, ".gif") > 0 Then
            picPath = Link & "\" & picName
        End If
        
        'Insert the picture from file
        Set pic = ActiveSheet.Pictures.Insert(picPath)
        
        'Set the name of the picture
        pic.Name = picName
        
        'Set the position of the picture
        With pic
            .Left = ActiveSheet.cell.Left
            .Top = ActiveSheet.cell.Top
        End With
    Next cell
End Sub

 

[John_w]

I have question about your code.

If my file name is 001,002 and 003
(.png, .jpeg = the type of picture , not the file name).
How can I insert the picture with several type of picture?

That's no different to your OP and the Shapes.AddPicture in my macro already handles different types of image.

For your new macro, where the image file names are in A1:A5 and the folder path is in B1 on the active sheet, this inserts each image in its respective cell:

Public Sub Add_Pictures_On_Active_Sheet()

    Dim folder As String
    Dim cell As Range
    Dim pic As Shape
  
    With ActiveSheet
        folder = .Range("B1").Value
        If Right(folder, 1) <> "\" Then folder = folder & "\"
        For Each cell In .Range("A1:A5")
            Set pic = .Shapes.AddPicture(Filename:=folder & cell.Value, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
                                                   Left:=cell.Left, Top:=cell.Top, Width:=-1, Height:=-1)
        Next
    End With
  
End Sub