Insert Product Images to Excel Workbook

[RockyRobin]

Hi All

Complete Newbie here and am trying to enhance my knowledge of excel to stop myself taking hours to do jobs.

I have a stocklist that is currently in excel with product codes in column B. (eg 60080U-090)
I want to insert product images into column A. The product images are labelled as the style code (eg 60080U-090)

Now this is where you will chuckle, previously we have spent hours manually adding each image into the relevant cell and resizing.

I dont know much about macros/VBA but am more than willing to start learning.

If its any help:

Images are saved on a folder in the desktop labelled "Imagery"
The excel workbook is saved in the same folder and labelled "Stock"

Hope you guys can help me out and enlighten me.

Thanks in advance.

 

[Andrew Poulsom]

Welcome to MrExcel.

See if you can adapt the example here:

http://www.mrexcel.com/forum/excel-questions/604604-insert-image-url-images-into-cells.html

 

[RockyRobin]

Welcome to MrExcel.

See if you can adapt the example here:

http://www.mrexcel.com/forum/excel-questions/604604-insert-image-url-images-into-cells.html

Hi

Thanks for the prompt help.
Obviously as I'm a excel dummy I'm trying to get my head around the post you told me to look at.

Not really too sure what to change apart from the Cell location.

Sorry for being useless.

 

[Andrew Poulsom]

What's the file extension of your images?

 

[RockyRobin]

What's the file extension of your images?

Hi

All the images are .jpg

Thanks

 

[Andrew Poulsom]

Try (untested):

Sub Test()
    Dim Rng As Range
    Dim Cell As Range
    Dim Pic As Picture
    Application.ScreenUpdating = False
    Set Rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        With Cell
            Set Pic = .Parent.Pictures.Insert(ThisWorkbook.Path & Application.PathSeparator & .Value & ".jpg")
            With .Offset(, -1)
                Pic.Top = .Top
                Pic.Left = .Left
                Pic.Height = .Height
                Pic.Width = .Width
            End With
        End With
    Next Cell
    Application.ScreenUpdating = True
End Sub

 

[RockyRobin]

Try (untested):

Sub Test()
    Dim Rng As Range
    Dim Cell As Range
    Dim Pic As Picture
    Application.ScreenUpdating = False
    Set Rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        With Cell
            Set Pic = .Parent.Pictures.Insert(ThisWorkbook.Path & Application.PathSeparator & .Value & ".jpg")
            With .Offset(, -1)
                Pic.Top = .Top
                Pic.Left = .Left
                Pic.Height = .Height
                Pic.Width = .Width
            End With
        End With
    Next Cell
    Application.ScreenUpdating = True
End Sub

Hi

I ran the macro but received the message "Run Time Error 1004 Unable to get the insert property of the pictures class"

I tried the "End" button with this message and it appeared to put the first image in place correctly, but I was unable to drag the rule down to cover all the rows on the list.

Just to check I'm doing it the right way round, here are the steps I'm taking:-

Open workbook
Click into cell A2 (first line of product/stock)
Press Alt F11
Click Insert / Module
Paste the Code You Provided
Flick Back to Exel
Select View Tab,
Click Macro / View Macros
Highlight the Macro
Press Run

Sorry for being really painful but its the first time I've ever done anything like this.

All your help is truly appreciated,

 

[Andrew Poulsom]

If the names of the images start in row 2 change the Rng assignment:

Sub Test()
    Dim Rng As Range
    Dim Cell As Range
    Dim Pic As Picture
    Application.ScreenUpdating = False
    Set Rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        With Cell
            Set Pic = .Parent.Pictures.Insert(ThisWorkbook.Path & Application.PathSeparator & .Value & ".jpg")
            With .Offset(, -1)
                Pic.Top = .Top
                Pic.Left = .Left
                Pic.Height = .Height
                Pic.Width = .Width
            End With
        End With
    Next Cell
    Application.ScreenUpdating = True
End Sub

 

[RockyRobin]

If the names of the images start in row 2 change the Rng assignment:

Sub Test()
    Dim Rng As Range
    Dim Cell As Range
    Dim Pic As Picture
    Application.ScreenUpdating = False
    Set Rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        With Cell
            Set Pic = .Parent.Pictures.Insert(ThisWorkbook.Path & Application.PathSeparator & .Value & ".jpg")
            With .Offset(, -1)
                Pic.Top = .Top
                Pic.Left = .Left
                Pic.Height = .Height
                Pic.Width = .Width
            End With
        End With
    Next Cell
    Application.ScreenUpdating = True
End Sub

Almost there ;o)

I ran the macro, still had the Runtime Error but just clicked "End" and the images appeared exactly as I wanted but only on rows 02 - 11 (there are 700 rows).
Any suggestion as to what is going wrong?

If the image for row 12 is missing will the macro just leave that cell blank and continue populating those cells where it is able to locate the image?

Sorry one other query. Do i run the macro when I'm just in cell A2 or do in highlight all the cells (A2 - A733) or just highlight column A.

Thanks

 

[Andrew Poulsom]

Try:

Sub Test()
    Dim Rng As Range
    Dim Cell As Range
    Dim Pic As Picture
    Application.ScreenUpdating = False
    Set Rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        With Cell
            On Error Resume Next
            Set Pic = .Parent.Pictures.Insert(ThisWorkbook.Path & Application.PathSeparator & .Value & ".jpg")
            If Err = 0 Then
                With .Offset(, -1)
                    Pic.Top = .Top
                    Pic.Left = .Left
                    Pic.Height = .Height
                    Pic.Width = .Width
                End With
            Else
                Err.Clear
            End If
            On Error GoTo 0
        End With
    Next Cell
    Application.ScreenUpdating = True
End Sub