Inserting Photos into Excel

G

garrett1483

New Member
Joined
Sep 5, 2011
Messages
36
Hello All - First time using a forum but I thought this may be the only way to get the answer I need. I have an excel sheet and in Column A, I've got item#'s e.g. (A1007.jpg, A1008.jpg etc...). I have the corresponding photos in a folder on my desktop. I'd like a macro that will auto populate all the photos into the excel sheet in Column A, so the item#'s and the photos match up. Is there a way to do this? Any/All help would be appreciated.

Thanks
Garrett
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
Sort by date Sort by votes
Hi Garret,

Here's a crude start. Please try on a backup copy of your work

Hope it helps.

Gary

Code: 
Public Sub Test()

Dim sPath As String
Dim oCell As Range
Dim oRange As Range
Dim oPicture As Shape
Dim oSheet As Worksheet

sPath = "C:\Documents and Settings\glm\My Documents\My Pictures\" 'Change to suit

Set oSheet = ActiveSheet

Set oRange = oSheet.Range("A1:A" & oSheet.Range("A" & Rows.Count).End(xlUp).Row)

For Each oCell In oRange
    If Dir(sPath & oCell.Text) <> "" Then
        Set oPicture = oSheet.Shapes.AddPicture(Filename:=sPath & oCell, LinktoFile:=msoFalse, savewithdocument:=msoTrue, Left:=oCell.Left, Top:=oCell.Top, Width:=1, Height:=1)
        oPicture.ScaleHeight 1, True
        oPicture.ScaleWidth 1, True
    Else
        oCell.Offset(0, 1).Value = "Image file not found"
    End If
Next oCell

End Sub
 
Last edited:
Upvote 0
Hello,

Here maybe something you could use:

http://www.mrexcel.com/forum/showthread.php?t=572627



and here I have modified a bit... you can play with the size .Height, .Width to suit.

<font face=Courier New><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN><br><br><SPAN style="color:#00007F">Sub</SPAN> ThumbPartialName()<br>                                <SPAN style="color:#007F00">'''Repairman615, MrExcel.com</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> c               <SPAN style="color:#00007F">As</SPAN> Range, _<br>    Listrng         <SPAN style="color:#00007F">As</SPAN> Range, _<br>    i               <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, _<br>    myvar           <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN>, _<br>    myJPGobj        <SPAN style="color:#00007F">As</SPAN> OLEObject, _<br>    fPath           <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, _<br>    Ws              <SPAN style="color:#00007F">As</SPAN> Worksheet, _<br>    strFirstCell    <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br><br><SPAN style="color:#007F00">''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''</SPAN><br>strFirstCell = "A4"    <SPAN style="color:#007F00">''' Change this to your first cell with data in column A:A</SPAN><br><SPAN style="color:#007F00">''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''</SPAN><br>    <br><SPAN style="color:#00007F">Set</SPAN> Ws = Sheets("Sheet1")<br><SPAN style="color:#00007F">Set</SPAN> Listrng = Ws.Range(strFirstCell & ":A" & Range("A" & Rows.Count).End(xlUp).Row)<br><SPAN style="color:#007F00">''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''</SPAN><br>fPath = "Z:\Folder1\Folder2\Thumbnails\"   <SPAN style="color:#007F00">'''Change to your file path</SPAN><br><SPAN style="color:#007F00">''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''</SPAN><br>    <SPAN style="color:#00007F">If</SPAN> Right(fPath, 1) <> "\" <SPAN style="color:#00007F">Then</SPAN> fPath = fPath & "\"<br>    <br>    <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> c <SPAN style="color:#00007F">In</SPAN> Listrng<br>        <SPAN style="color:#00007F">If</SPAN> c.Value <> "" <SPAN style="color:#00007F">Then</SPAN><br>            <SPAN style="color:#007F00">'c.Select</SPAN><br>            myvar = FileList(fPath, c.Value & "*.jpg")<br>            <SPAN style="color:#00007F">If</SPAN> TypeName(myvar) <> "Boolean" <SPAN style="color:#00007F">Then</SPAN><br>                <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">UBound</SPAN>(myvar) - <SPAN style="color:#00007F">LBound</SPAN>(myvar) > 0 <SPAN style="color:#00007F">Then</SPAN><br>                    MsgBox "Multiple files match the entry:   " & c.Value & _<br>                            vbNewLine & "Located at:   " & c.Address & _<br>                            vbNewLine & "Only the first match will appear.", vbOKOnly, "Multiply results"<br>                    <SPAN style="color:#00007F">For</SPAN> i = <SPAN style="color:#00007F">LBound</SPAN>(myvar) <SPAN style="color:#00007F">To</SPAN> <SPAN style="color:#00007F">LBound</SPAN>(myvar)<br>                        <br>                        <SPAN style="color:#00007F">Set</SPAN> myJPGobj = ActiveSheet.OLEObjects.Add(Filename:= _<br>                            myvar(1), Link:=True, _<br>                            DisplayAsIcon:=False)<br>                            <SPAN style="color:#00007F">With</SPAN> myJPGobj<br>                                .Top = c.Top<br>                                .Left = c.Offset(0, -1).Left<br>                                .Height = 0.51 * 72<br>                                .Width = 0.32 * 72<br>                            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>                    <SPAN style="color:#00007F">Next</SPAN> i<br>                <SPAN style="color:#00007F">Else</SPAN><br>                    <SPAN style="color:#007F00">'For i = LBound(myvar) To UBound(myvar)</SPAN><br>                        <br>                        <SPAN style="color:#00007F">Set</SPAN> myJPGobj = ActiveSheet.OLEObjects.Add(Filename:= _<br>                            myvar, Link:=True, _<br>                            DisplayAsIcon:=False)<br>                            <SPAN style="color:#00007F">With</SPAN> myJPGobj<br>                                .Top = c.Top<br>                                .Left = c.Offset(0, -1).Left<br>                                .Height = 0.51 * 72     <SPAN style="color:#007F00">'''Sets Height</SPAN><br>                                .Width = 0.32 * 72      <SPAN style="color:#007F00">'''Sets Width</SPAN><br>                            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>                    <SPAN style="color:#007F00">'Next i</SPAN><br>                <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>            <SPAN style="color:#00007F">Else</SPAN><br>                MsgBox "For " & c.Value & ", no file was found.", vbOKOnly, "Possible Error"<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> c<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><SPAN style="color:#007F00">'''I beleive the below came from Richard Schollar</SPAN><br><SPAN style="color:#00007F">Function</SPAN> FileList(fldr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, <SPAN style="color:#00007F">Optional</SPAN> fltr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> sTemp <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, sHldr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>    <SPAN style="color:#00007F">If</SPAN> Right$(fldr, 1) <> "\" <SPAN style="color:#00007F">Then</SPAN> fldr = fldr & "\"<br>    sTemp = Dir(fldr & fltr)<br>    <SPAN style="color:#00007F">If</SPAN> sTemp = "" <SPAN style="color:#00007F">Then</SPAN><br>        FileList = <SPAN style="color:#00007F">False</SPAN><br>        <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Function</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">Do</SPAN><br>        sHldr = Dir<br>        <SPAN style="color:#00007F">If</SPAN> sHldr = "" <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Do</SPAN><br>        sTemp = sTemp & "|" & sHldr<br>    <SPAN style="color:#00007F">Loop</SPAN><br>    FileList = Split(sTemp, "|")<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Function</SPAN><br><br><br></FONT>


-Jeff
 
Upvote 0
THanks for the help - when I tried to run your macro, it worked but I still got a error msg -

Run-time error '1004'
Application-defined or object-defined error

It refers to line

Set oPicture = oSheet.Shapes.AddPicture(Filename:=sPath & oCell, LinktoFile:=msoFalse, savewithdocument:=msoTrue, Left:=oCell.Left, Top:=oCell.Top, Width:=1, Height:=1)

...says to debug this line... not sure why though... any idea?



Thanks
Garrett

Gary McMaster said:
Hi Garret,

Here's a crude start. Please try on a backup copy of your work

Hope it helps.

Gary

Code: 
Public Sub Test()
 
Dim sPath As String
Dim oCell As Range
Dim oRange As Range
Dim oPicture As Shape
Dim oSheet As Worksheet
 
sPath = "C:\Documents and Settings\glm\My Documents\My Pictures\" 'Change to suit
 
Set oSheet = ActiveSheet
 
Set oRange = oSheet.Range("A1:A" & oSheet.Range("A" & Rows.Count).End(xlUp).Row)
 
For Each oCell In oRange
    If Dir(sPath & oCell.Text) <> "" Then
        Set oPicture = oSheet.Shapes.AddPicture(Filename:=sPath & oCell, LinktoFile:=msoFalse, savewithdocument:=msoTrue, Left:=oCell.Left, Top:=oCell.Top, Width:=1, Height:=1)
        oPicture.ScaleHeight 1, True
        oPicture.ScaleWidth 1, True
    Else
        oCell.Offset(0, 1).Value = "Image file not found"
    End If
Next oCell
 
End Sub
Click to expand...
 
Upvote 0
Maybe an empty cell in the middle of your list in column A.

Please try the following (change highlighted red).

Gary

Code: 
Public Sub Test()

Dim sPath As String
Dim oCell As Range
Dim oRange As Range
Dim oPicture As Shape
Dim oSheet As Worksheet

sPath = "C:\Documents and Settings\glm\My Documents\My Pictures\" 'Change to suit

Set oSheet = ActiveSheet

Set oRange = oSheet.Range("A1:A" & oSheet.Range("A" & Rows.Count).End(xlUp).Row)

For Each oCell In oRange
    [COLOR=Red]If Dir(sPath & oCell.Text) <> "" And oCell.Value <> "" Then[/COLOR]
        Set oPicture = oSheet.Shapes.AddPicture(Filename:=sPath & oCell, LinktoFile:=msoFalse, savewithdocument:=msoTrue, Left:=oCell.Left, Top:=oCell.Top, Width:=1, Height:=1)
        oPicture.ScaleHeight 1, True
        oPicture.ScaleWidth 1, True
        oCell.RowHeight = oPicture.Height
        oCell.ColumnWidth = oPicture.Width / 4
    Else
        oCell.Offset(0, 1).Value = "Image file not found"
    End If
Next oCell

End Sub
 
Upvote 0
Oddly enough - now it seems to freeze my excel sheet and I have to open the task manager to get out of it now haha, any recommendations?

Thanks
Garrett
 
Upvote 0
I got it to unfreeze, but now when I make the adjustments it says it's still messed up - below is the code exactly as it's entered, there are no breaks in the column.

Public Sub Test()
Dim sPath As String
Dim oCell As Range
Dim oRange As Range
Dim oPicture As Shape
Dim oSheet As Worksheet
sPath = "C:\ASUS WebStorage\garrett1483\MySyncFolder\Crazy Close Out Photos\" 'Change to suit
Set oSheet = ActiveSheet
Set oRange = oSheet.Range("A1:A104" & oSheet.Range("A" & Rows.Count).End(xlUp).Row)
For Each oCell In oRange
If Dir(sPath & oCell.Text) <> "" And oCell.Value <> "" Then
Set oPicture = oSheet.Shapes.AddPicture(Filename:=sPath & oCell, LinktoFile:=msoFalse, savewithdocument:=msoTrue, Left:=oCell.Left, Top:=oCell.Top, Width:=1, Height:=1)
oPicture.ScaleHeight 1, True
oPicture.ScaleWidth 1, True
oCell.RowHeight = oPicture.Height
oCell.ColumnWidth = oPicture.Width / 4
Else
oCell.Offset(0, 1).Value = "Image file not found"
End If
Next oCell
End Sub

Thanks
Garrett
 
Upvote 0
104 on 1 sheet, and 121 on another sheet - I've done this macro before, but I lost the coding for it, last time it was more photos and the system had no problems - sorry for all the trouble.
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question Question
Vba has stopped adding hyperlink to my customers name
Replies
3
Views
101
ipbr21054
I
J
  • Question Question
Inserting pictures into cells
Replies
1
Views
108
Trevor G
Trevor G
E
  • Question Question
insert picture by VBA
Replies
1
Views
472
rlv01
R
Q
  • Question Question
Import multiple photos from folders in columns
Replies
2
Views
213
Qba
Q
S
  • Solved
VBA for inserting multiple photos from a specified folder
2
Replies
12
Views
788
SomeOrdinaryIndian
S

Forum statistics

Threads
1,224,548
Messages
6,179,448
Members
452,915
Latest member
hannnahheileen

Share this page

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