Report

Macro - pictures to excel acc to name [Solved]

Ask a question Northimn 2Posts Friday August 5, 2016Registration date August 10, 2016 Last seen - Latest answer on Aug 10, 2016 09:20AM
Hi,
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:
Sub IMPORTPHOTOS()
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
Range("I6").Select
End Sub
See more 
Helpful
+0
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,
Trowa
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!

Regards,

R.
Reply
Add comment

Members get more answers than anonymous users.

Being a member gives you detailed monitoring of your requests.

Being a member gives you additional options.

Not a member yet?

sign-up, it takes less than a minute and it's free!