Insert pictures into excel from a folder

[John Steel]

Greetings everyone,

First off let me say that I have searched for a day on this site and others trying to find an solution to my problem. I'm trying to insert five pictures into excel by looking them up via five reference cells containing the pictures' names on the worksheet.

Some of the things I'd like to accomplish with the macro:

1. The macro would delete any existing pictures in the target areas.
2. The pictures would maintain their aspect ratio and resize to the exisiting row height and be centered in the target range (four cells wide)
3. If one of the references for the picture name is blank - delete any existing picture and skip attempting to import anything for that item

Here are my reference and target cells

Reference Cell (Name of picture file)	Target Range for importing picture
A1	C3:F3
A40	C42:F42
A79	C81:F81
A118	C120:F120
A157	C159:F159

<tbody>
</tbody>

My picture files are all .jpg and located at "C:\Users\jstee\Dropbox\Comp photos" The worksheet is called "Comp Sheets" Hopefully I've not omitted anything required in my explanation.

The code I've tried to adapt from is for just one picture at this time as I want to get that to work before adding the loop necessary to do the other four pictures - although this I'll need help with as well I imagine. Here's what I have so far. I haven't gotten it to import anything so my troubleshooting is still in its infancy.

Sub Picture()
Dim picname As String

Range("C3:F3").Select 'This is where picture will be inserted

picname = Range("A1") 'This is the picture name

On Error Resume Next
'delete previous pic
ActiveSheet.Pictures("Comp Sheets").Delete
Err.Clear
Err.Number = 0
On Error GoTo 0

If (Dir("C:\Users\jstee\Dropbox\Comp photos" & picname & ".jpg") = vbNullString) Then Exit Sub

ActiveSheet.Pictures.Insert("C:\Users\jstee\Dropbox\Comp photos" & picname & ".jpg").Select 'Path to where pictures are stored
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This resizes the picture
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Selection
.Name = "Comp Sheets"
.Left = Range("C3:F3").Left
.Top = Range("C3:F3").Top
.ShapeRange.LockAspectRatio = msoTrue
.ShapeRange.Height = 95#
.ShapeRange.Width = 80#
.ShapeRange.Rotation = 0#
End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If (Intersect(Target, Range("A1")) Is Nothing) Then
Exit Sub
End If

Application.EnableEvents = False
Call Picture
Application.EnableEvents = True
End Sub​

Any help would be greatly appreciated.

Thank you

 

[Perpa]

Greetings everyone,

First off let me say that I have searched for a day on this site and others trying to find an solution to my problem. I'm trying to insert five pictures into excel by looking them up via five reference cells containing the pictures' names on the worksheet.

Any help would be greatly appreciated.

Thank you

John,
Welcome to the Forum. Searching can be tedious, but it is one of the ways we learn. The following may help. But first I need to clarify a couple of things:

I noticed that the folder where your files are stored is shown as 'jstee', not 'jsteel'. I Just want to make sure that is correct?
Also, the 'Name of picture file' in each of the 5 cells should be in the following format: 'filename.jpg', where 'filename' is 'image001', or 'myPic', or some name followed by the '.jpg' extension.

The following code will load ALL 5 pictures from the folder "C:\Users\jstee\Dropbox\Comp photos" to your sheet "Comp Sheets". It is important that the last '\' be included for this to work. I copied the code from the following link and modified it for your circumstances:

Excel-VBA : Insert Multiple Images from a Folder to Excel Cells
You can have a look for yourself.
Perpa

Sub AddOlEObject()
    Dim Folderpath, fls, strCompFilePath As String
    Dim counter, counter2 As Long
    Dim sh As Shape
    Application.ScreenUpdating = False
  
    Sheets("Comp Sheets").Activate           'Change the sheet name to the sheet name where you want your pictures to go
        For Each sh In ActiveSheet.Shapes
           sh.Delete
        Next sh
    Range("C3:F3").ColumnWidth = 22    'Adjust to fit your pictures
    Folderpath = "C:\Users\jstee\Dropbox\Comp photos\"    'Change the folderpath if different
            For counter = 1 To 157 Step 39
                fls = Sheets("Comp Sheets").Range("A" & counter).Value
                If fls = "" Then GoTo SKIP_PIC
                strCompFilePath = Folderpath & fls
                Sheets("Comp Sheets").Range("C" & counter).Offset(2, 0).RowHeight = 95          'Adjust to fit your pictures
                Sheets("Comp Sheets").Range("C" & counter).Offset(2, 0).Activate
                counter2 = counter + 2    'Moves the row where the picture will be placed from 1 to 3 for C3:F3, 40 to 42 for C42:F42, and so on
                Call insert(strCompFilePath, counter2)
                Sheets("Comp Sheets").Activate
SKIP_PIC:
            Next
Application.ScreenUpdating = True
End Sub

Function insert(PicPath, counter2)
   Set objPicture = ActiveSheet.Pictures.insert(PicPath)
    With objPicture
        With .ShapeRange
            .LockAspectRatio = msoTrue     'Height and Width cannot BOTH be set if the Aspect Ratio is LOCKED
            '.Width = 50      'Adjust to change the WIDTH of your pictures - currently commented out
            .Height = 95     'Adjust to change the HEIGHT of your pictures
        End With
       'This next 'With' centers the picture in the 4 cells
        With ActiveSheet.Range("C" & counter2 & ":F" & counter2)
              objPicture.Left = .Left + .Width \ 2 - objPicture.Width \ 2
        End With
 
        .Top = ActiveSheet.Range("C" & counter2 & ":F" & counter2).Top
        .Placement = 1
        .PrintObject = True
    End With
End Function

 

[John Steel]

Thank you Perpa,

Running the code you suggested results in an error. Besides it not running it appears to be lacking two items I require:

1. I need the code to lookup the picture name for the pictures being inserted. The folder with the pictures has hundreds of .jpg files and I am using five cell references in A1, A39, A78, A117 and A156 on the target sheet to "call" the correct picture files.

2. I'd also like the code to delete any existing pictures in the target cells.

I am sure of the folder where the picture files are stored having the file path of "C:\Users\jstee\Dropbox\Comp photos" and know that I need to use this followed by a "/", the filename and ".jpg" in order to call the pictures correctly.

If you or others have additional feedback I'd welcome it.

Thanks

 

[Perpa]

John,
I ran the code and function on my computer and it ran without error. However, I noticed in your second post you changed the cells where the picture names are supposed to be:
In your initial post you said the names were in 'A1, A40, A79, A118, and A157'.
In your latest post you have changed that to 'A1, A39, A78, A117 and A156'.
For clarification, the following line of code 'looks for the picture name' using the 'Insert Function' I provided:

Call insert(strCompFilePath, counter2)

The Function has 2 arguments - 'strCompFilePath' which is the complete path and filename, ie. 'C:\Users\jstee\Dropbox\Comp photos\filename.jpg'
and 'counter2' which is the row where the picture is to be inserted, 2 rows below the row with the picture names.
Looking at your complete path and filename I am now wondering if the '\Comp photos\' portion is causing the error due to the 'space' between 'Comp' and 'photos' in that foldername?
You might check the folder name again and if the name is different, change the line that reads:

Folderpath = "C:\Users\jstee\Dropbox\Comp photos\"    'Change the folderpath if different

With regards to your item 2 - the first 'FOR/NEXT' loop deletes any pictures/shapes from the ActiveSheet which is 'Sheets("Comp Sheets").Activate'.
But until we fix the error the code will not execute.
Hopefully these bits of information will be useful and help locate the error. If not, then please tell us what the error code is and what line of code is highlighted showing the error.
Perpa

 

[John Steel]

Thanks again Perpa for the time you're taking to explain the bits of code. I'm rather new with this so your patience is much appreciated.

First off I made an error in my reply post that I apologize for - it was correct the first time - the code should be referencing the cells A1, A39, A78, A117 and A156 to pull the picture name. This was correct in the code you provided.

I played around with it for a bit and have Good News!!! I was looking at the line (below) calling the picture file name. My reference cell only has the file name without the file type on the end - i.e. "Comp 00001". I thought ".jpg" was needed at the end of the filename, either in the code or the reference cell so I changed my reference cells in column A to include ".jpg" at the end of each file name - i.e. "Comp 00001.jpg". It now works wonderfully.

[COLOR=#574123]strCompFilePath = Folderpath & fls[/COLOR]

Thanks so much - this automates an otherwise tedious and repetitive task for me.

 

[John Steel]

Hey Perpa,

I was planning on putting a button on sheet to call the macro. Unfortunately when the macro gets called it deletes all pictures, including the macro button, from the page.

I know I can call the macro manually but is there a way to maintain a button to call the macro? Can the code that's deleting all pictures on the sheet be modified to just affect C:F and I could keep the macro button over in columns A & B?

Sheets("Comp Sheets").Activate           'Change the sheet name to the sheet name where you want your pictures to go
        For Each sh In ActiveSheet.Shapes
           sh.Delete
        Next sh

Thanks again - I'm really thrilled with how it works - I modified the cell and pic height to look just the way I wanted.

 

[Perpa]

Thanks so much - this automates an otherwise tedious and repetitive task for me.

John,
It usually is something that simple. You are quite welcome.
By the way, if you didn't want to include the '.jpg' in the column A filenames, you could change this line of code:

strCompFilePath = Folderpath & fls

To:

strCompFilePath = Folderpath & fls & ".jpg"

Have a great day!
Perpa

 

[John Steel]

Perpa,

Any feedback regarding being able to use a macro button?

Hey Perpa,

I was planning on putting a button on sheet to call the macro. Unfortunately when the macro gets called it deletes all pictures, including the macro button, from the page.

I know I can call the macro manually but is there a way to maintain a button to call the macro? Can the code that's deleting all pictures on the sheet be modified to just affect C:F and I could keep the macro button over in columns A & B?

Sheets("Comp Sheets").Activate           'Change the sheet name to the sheet name where you want your pictures to go
        For Each sh In ActiveSheet.Shapes
           sh.Delete
        Next sh

Thanks again - I'm really thrilled with how it works - I modified the cell and pic height to look just the way I wanted.

 

[Perpa]

Perpa,

Any feedback regarding being able to use a macro button?

John,
There may be other ways to add a button that will not be deleted, but one way is to Customize the Quick Access Toolbar. It is at the very top of the worksheet, on the lefthand side, there is a dropdown arrow on the right.
If you hover your mouse arrow over the arrow it should display 'Customize the Quick Access Toolbar'.

To add a button to the Quick Access Toolbar:
Select the down arrow to the right side of that tool bar
Select 'More Commands' from the drop down
In the bar with the header 'Choose Commands from' select 'Macros' from the dropdown
The 'AddOlEObject' macro should be at the top of the list, select it then press 'Add'.
You can select a different icon button if you press 'Modify' before you press 'OK'.
The icon shown will be added to the Quick Access Toolbar when you press 'OK'.
This macro button will stay there until you remove it, and will only work if the macro 'AddOlEObject' exists in the Active workbook.
That will give you a button to run this macro that will not be deleted.
Perpa

 

[Perpa]

Perpa,

Any feedback regarding being able to use a macro button?

John,
I did some digging on 'shapes' and found the code snippet you require to delete just the pictures but not the buttons. It is just one line.
Replace this:

         For Each sh In ActiveSheet.Shapes
              [COLOR=#ff0000]sh.Delete[/COLOR]
        Next sh

With this

        For Each sh In ActiveSheet.Shapes
              [COLOR=#ff0000]If sh.Type = msoPicture Then sh.Delete[/COLOR]
        Next sh

Like we said earlier...it is usually something simple.
Perpa