use reference cell to insert a picture in a specific cell

[sully3868]

I have some VBA code here but I keep getting an error on line 11. I need the code to look at the text in the B column and then go to the specified folder and find the jpg file of the same name and then insert it into the excel sheet. This is a very simplified excel sheet, I need to change the code after for a different excel sheet which is much larger but the code should still work. Thanks.


Private Sub CommandButton1_Click()
Dim animal_pic As Pictures
Dim pic_location As String
Dim animal_name As String
For i = 2 To 6
animal_name = Worksheets("Sheet1").Cells(2, 2).Value
pic_location = "C:\Users\osullij2\Desktop\Animal Picture\" & Worksheets("Sheet1").Cells(2, 2).Value & ".jpg"

With Worksheets("Sheet1").Cells(i, 3)
Set animal_pic = ActiveSheet.Pictures.Insert(pic_location)

animal_pic.Top = .Top
animal_pic.Left = .Left
animal_pic.ShapeRange.LockAspectRatio = msoFalse
animal_pic.Placement = xlMoveAndSize
animal_pic.ShapeRange.Width = 170
animal_pic.ShapeRange.Height = 100
End With
Next
Worksheets("Sheet1").Cells(1, 1).Select
End Sub

 

[Candyman8019]

Try something like this:
replace:

With Worksheets("Sheet1").Cells(i, 3)
Set animal_pic = ActiveSheet.Pictures.Insert(pic_location)

animal_pic.Top = .Top
animal_pic.Left = .Left

with

Set animal_pic = ActiveSheet.Pictures.Insert(pic_location)
With animal_pic
.Top = Worksheets("Sheet1").Cells(i, 3).Top
.Left = Worksheets("Sheet1").Cells(i, 3).Left


..etc

 

[sully3868]

Thanks for the reply. Code still not working unfortunately

 

[Fluff]

Hi & welcome to MrExcel.
How about

Private Sub CommandButton1_Click()
   Dim animal_pic As Picture
   Dim pic_location As String
   Dim animal_name As String
   For i = 2 To 6
      animal_name = Worksheets("Sheet1").Cells(i, 2).Value
      pic_location = "C:\Users\osullij2\Desktop\Animal Picture\" & animal_name & ".jpg"
      
      With Worksheets("Sheet1").Cells(i, 3)
         Set animal_pic = ActiveSheet.Pictures.Insert(pic_location)
         
         animal_pic.Top = .Top
         animal_pic.Left = .Left
         animal_pic.ShapeRange.LockAspectRatio = msoFalse
         animal_pic.Placement = xlMoveAndSize
         animal_pic.ShapeRange.Width = 170
         animal_pic.ShapeRange.Height = 100
      End With
   Next
   Worksheets("Sheet1").Cells(1, 1).Select
End Sub

 

[sully3868]

still the same error, not sure what to try next

 

[Fluff]

What is the error you get?

 

[sully3868]

"Run-time error '1004'
Unable to get the Insert property of the Pictures class"

 

[Fluff]

In that case check the the path & file name are correct. It's probably a typo somewhere or extra spaces.
Also do the values in B2:B6 have the file extension?

 

[sully3868]

yes they do. Its kind of half working now. The error is still coming up but when I click end rather than debug, the picture of the tiger appears in cell C2.

 

[Fluff]

yes they do

Than that is the problem. You are adding the extension on again in the code.
Use

pic_location = "C:\Users\osullij2\Desktop\Animal Picture\" & animal_name