Multi pictures insert in square shape with macro

Programmer24

New Member
Joined
Nov 24, 2021
Messages
1
Office Version
  1. 365
Platform
  1. Windows
I want to create a macro that look a specific cell and find the picture with the same name in one particular folder and insert it into a specific shape.

1637802847699.png

For exemple, I want the macro to insert the picture that is called PIC1 from the dedicated folder in the first square, the picture that is called PIC2 from the same dedicated folder in the second square and so on for as many picture as needed.

Also, I would like the macro to find them and insert them all in only one click.

Can someone help me :) ?

Juste give me the right structure and I'll insert my value where they belong.
 

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
You might consider the following...

VBA Code:
Sub InsertPics()
Dim r As Range
Dim shp As Shape
Dim pth As String, fName As String, NotFound As String
Application.ScreenUpdating = False
pth = "C:\Docs 2021\2021 Miscellaneous\" 'Change to your folder path

For Each r In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    If r.Value <> "" Then
        fName = Dir(pth & r.Value)
        If fName <> "" Then
            Set shp = ActiveSheet.Shapes.AddPicture(Filename:=pth & r.Value, linktofile:=msoFalse, _
                savewithdocument:=msoTrue, Left:=Cells(r.Row, 2).Left, Top:=Cells(r.Row, 2).Top, _
                    Width:=-1, Height:=-1)
            With shp
                .LockAspectRatio = msoTrue
                .Width = Columns(2).Width
                Rows(r.Row).RowHeight = .Height
            End With
        Else
            NotFound = NotFound & vbCrLf & r.Value
        End If
    End If
Next r
Application.ScreenUpdating = True
MsgBox "These pictures were not found: " & vbCrLf & NotFound
End Sub

Cheers,

Tony
 
Upvote 0

Forum statistics

Threads
1,214,851
Messages
6,121,931
Members
449,056
Latest member
denissimo

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top