Solved Macro for inserting pictures from folder to excel 2010

March 20, 2018 at 06:09:35
Specs: Windows 7
Hi guys I am new here and would appreciate any help for the following issue:

I have an excel sheet with more than 100 product codes (e.g. 00501-0165) in column C. Now I have another folder (path: C:\Users\arno01\Desktop\Onboarding\PICTURES) which contains all the pictures in jpeg. format for all these product codes. The pictures have the same name as the product codes.

Now I am looking for a macro which assigns the respective pictures from the folder next to the product codes in Column A in ecxel.

Can anybody help me with this issue?

Thank you very much in advance.

Grig


See More: Macro for inserting pictures from folder to excel 2010


✔ Best Answer
March 22, 2018 at 11:27:32
First, a posting tip:

Please click on the How-To link at the end of this post and read the instructions on how to post VBA code in this forum so that it is easier for us to read. Then edit/repost your code so that it looks similar to the example found via that link. Thanks.

You could probably use an Error Handler routine so that the code doesn't just fail when an image isn't found. When the error occurs, the code jumps to the noImg label. The Resume instruction clears the error and sends the code back up to the nextPic label and then continues through the Loop.

==================================================================

Sub InsertPics()

'Loop through Rows 2 - 100
    For rw = 2 To 10
     On Error GoTo noImg

'Insert jpg into based on string in Column B
'(Enter the correct path below)
      ActiveSheet.Pictures.Insert _
          ("W:\H2'18\6. VLP\PICTURES\" _
           & Range("B" & rw) & ".jpg").Select

'Position and size image
      With ActiveSheet.Shapes(Selection.Name)
         .Left = ActiveSheet.Cells(rw, 1).Left
         .Top = ActiveSheet.Cells(rw, 1).Top
         .ScaleWidth 0.7, msoFalse, msoScaleFromTopLeft
         .ScaleHeight 0.4, msoFalse, msoScaleFromTopLeft
      End With

nextPic:
    Next

noImg:
    If rw < 101 Then
     Resume nextPic
    End If

End Sub

==================================================================

As far as resizing, try something like:

.Height = 100

If you specify only the Height or only the Width, the aspect ratio should be retained.

How To Post Data or Code ---> Click Here Before Posting Data or VBA Code



#1
March 20, 2018 at 12:14:23
This is not something that I have tried before, but I played around a bit.

I recorded a macro while inserting a image into a worksheet. I then modified the resulting code to loop through a range of cells and use the text in the cells to insert the corresponding image into the worksheet.

The code then moves the images to Column A and resizes them to be about the size of the cells.

That's about the best I can offer right now, but feel free to come back with more details/questions and remember: Google is your friend. Code examples found on the web can often be modified to fit various situations. That's kind of how I ended up with the code below.

(You'll need to put the correct path to your files in place of the path shown in the code.)

Sub InsertPics()
'Loop through Rows 1 - 4
  For rw = 1 To 4

'Insert jpg into based on string in Column D
'(Enter the correct path below)
    ActiveSheet.Pictures.Insert _
           ("\\server_name\folder_name\user_name\Desktop\picture_folder_name\" _
           & Range("D" & rw) & ".jpg").Select
        
'Position and size image
     With ActiveSheet.Shapes(Selection.Name)
          .Left = ActiveSheet.Cells(rw, 1).Left
          .Top = ActiveSheet.Cells(rw, 1).Top
          .ScaleWidth 0.2, msoFalse, msoScaleFromTopLeft
          .ScaleHeight 0.2, msoFalse, msoScaleFromTopLeft
      End With
  
  Next
End Sub

How To Post Data or Code ---> Click Here Before Posting Data or VBA Code


Report •

#2
March 21, 2018 at 01:53:44
Hey Derbydad03,

thank you very much for your reply. It works very good.

I have now got 2 minor issues which you maybe will be able to solve:

1) In cases where the macro can not find a picture in a particular cell e.g. cell 10, it stops looking for the following codes that come after cell 10. Is it possible to write it in a way which enables the macro to ignore these kind of "errors" and keep checking for the following cells?

2) The pictures in the folder from which the macro transfers them to excel are saved in different sizes. Hence, all pictures being inserted in excel are also in different sizes which is a bit of a problem.

Now my question is whether we can change the code in a way that inserts all pictures to the fixed hight and wthd. of column A.


Here is the current code:

Sub InsertPics()
'Loop through Rows 2 - 100
For Rw = 2 To 100

'Insert jpg into based on string in Column B
'(Enter the correct path below)
ActiveSheet.Pictures.Insert _
("W:\H2'18\6. VLP\PICTURES\" _
& Range("B" & Rw) & ".jpg").Select

'Position and size image
With ActiveSheet.Shapes(Selection.Name)
.Left = ActiveSheet.Cells(Rw, 1).Left
.Top = ActiveSheet.Cells(Rw, 1).Top
.ScaleWidth 0.7, msoFalse, msoScaleFromTopLeft
.ScaleHeight 0.4, msoFalse, msoScaleFromTopLeft
End With
Next
End Sub


Many thanks in advance
Gigi

message edited by gigi2803


Report •

#3
March 21, 2018 at 19:38:38
First, a posting tip:

Please click on the How-To link at the end of this post and read the instructions on how to post VBA code in this forum so that it is easier for us to read. Then edit/repost your code so that it looks similar to the example found via that link. Thanks.

You could probably use an Error Handler routine so that the code doesn't just fail when an image isn't found. When the error occurs, the code jumps to the noImg label. The Resume instruction clears the error and sends the code back up to the nextPic label and then continues through the Loop.

The following method will not work under certain conditions. Please see the next post.

==================================================================

Sub InsertPics()

'Loop through Rows 2 - 100
For Rw = 2 To 100
On Error GoTo NoImg

...Your Code...

nextPic:
Next

noImg:
Resume nextPic

End Sub
==================================================================

As far as resizing, try something like:

.Height = 100

If you specify only the Height or only the Width, the aspect ratio should be retained.

How To Post Data or Code ---> Click Here Before Posting Data or VBA Code

message edited by DerbyDad03


Report •

Related Solutions

#4
March 22, 2018 at 11:27:32
✔ Best Answer
First, a posting tip:

Please click on the How-To link at the end of this post and read the instructions on how to post VBA code in this forum so that it is easier for us to read. Then edit/repost your code so that it looks similar to the example found via that link. Thanks.

You could probably use an Error Handler routine so that the code doesn't just fail when an image isn't found. When the error occurs, the code jumps to the noImg label. The Resume instruction clears the error and sends the code back up to the nextPic label and then continues through the Loop.

==================================================================

Sub InsertPics()

'Loop through Rows 2 - 100
    For rw = 2 To 10
     On Error GoTo noImg

'Insert jpg into based on string in Column B
'(Enter the correct path below)
      ActiveSheet.Pictures.Insert _
          ("W:\H2'18\6. VLP\PICTURES\" _
           & Range("B" & rw) & ".jpg").Select

'Position and size image
      With ActiveSheet.Shapes(Selection.Name)
         .Left = ActiveSheet.Cells(rw, 1).Left
         .Top = ActiveSheet.Cells(rw, 1).Top
         .ScaleWidth 0.7, msoFalse, msoScaleFromTopLeft
         .ScaleHeight 0.4, msoFalse, msoScaleFromTopLeft
      End With

nextPic:
    Next

noImg:
    If rw < 101 Then
     Resume nextPic
    End If

End Sub

==================================================================

As far as resizing, try something like:

.Height = 100

If you specify only the Height or only the Width, the aspect ratio should be retained.

How To Post Data or Code ---> Click Here Before Posting Data or VBA Code


Report •

Ask Question