Macro - pictures to excel acc to name [Solved]

Ask a question Northimn 2Posts Friday August 5, 2016Registration date August 10, 2016 Last seen - Last answered on Aug 10, 2016 09:20AM

I have an issue - I checked all forums I could, but with office 2013 and changed excel functions, I got lost.

My excel has pictures names in column A, I ussually want to add pics to other column, say K. In office 2010 it was easy, but with 2013 some functions changed, and instead of inserting pics, the excel only inserts links to pics. So, if I open the file in anothe pc, I see no pics.

So far, I was able to find below mentioned macro (from several forums, I cannot program it though). There is only one problem - when I import 1000 or so pics, at some point the pics are moved. For some reason the macro puts two pics over each other - e.g. pic from A313 is under a pic from A314, both in the K313 cell. all following pics are moved up. It takes ages to repair that. Any help?

the macro:

Dim dblLeft As Double
Dim dblTop As Double
Dim shpImage As Shape
Dim Image As String
Dim X As Integer
Dim TotalRows

TotalRows = ActiveSheet.UsedRange.Rows.Count

For X = 1 To TotalRows
'Set the row height and width of the cell to contain image
ActiveSheet.Range("f2").Offset(X - 1, 0).ColumnWidth = 20
ActiveSheet.Range("f2").Offset(X - 1, 0).RowHeight = 60

'Assign left and top of cell to variables
dblLeft = ActiveSheet.Range("f2").Offset(X - 1, 0).Left
dblTop = ActiveSheet.Range("f2").Offset(X - 1, 0).Top

Image = "E:\Smazat\excel\" & Range("A2").Offset(X - 1, 0) & ".jpg"
On Error Resume Next
'Code to set Width and Height at time of import _
using Shapes.AddPicture
Set shpImage = ActiveSheet.Shapes.AddPicture _
(Image, False, True, dblLeft, dblTop, -1, -1)
With shpImage
.Height = 50
End With

'Alternative code to lock aspect ratio during import with _
parameters -1 for Width and Height lock the aspect ratio.
'Set shpImage = ActiveSheet.Shapes.AddPicture _
(Image, False, True, dblLeft, dblTop, -1, -1)

'Following code only required if dimensions set after import. _
When Aspect ratio is locked then only need to set either Height or Width _
and the other is set automatically. If both set then will set both _
Height and Width keeping Aspect ratio by the latter line of code.
'With shpImage
' .Height = 80
'End With

'Center the image in the cell.
With shpImage
.Left = .TopLeftCell.Left + (.TopLeftCell.Width - .Width) / 2
.Top = .TopLeftCell.Top + (.TopLeftCell.Height - .Height) / 2
End With

Next X

End Sub
See more 
moins plus
Hi Northimn,

In the code below, the picture size will match the row height. Try it:
Sub RunMe()
Dim myPict As Picture

For Each cell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
    With Cells(cell.Row, "K")
    Set myPict = .Parent.Pictures.Insert("C:\Images\" & cell.Value & ".jpg")
        myPict.Top = .Top
        myPict.Width = .Width
        myPict.Height = .Height
        myPict.Left = .Left
        myPict.Placement = xlMoveAndSize
    End With
Next cell
End Sub

Best regards,
Northimn 2Posts Friday August 5, 2016Registration date August 10, 2016 Last seen - Aug 10, 2016 09:20AM
Hi TrowaD!

thank you for the time to answer me! As soon as I get to the excell, I will test it!


Add comment

Member requests are more likely to be responded to.

Members can monitor the statuses of their requests from their account pages.

A CCM membership gives you access to additional options.

Not a member yet?

Sign up now. It takes less than a minute and is completely free!