Saturday, August 13, 2011

Thousands pictures to your sheet

Several days ago I get a job from a good man, he ask me to put his thousands pics to his worksheet. Until I do this to my macro:

Sub INSERTPics()
Application.ScreenUpdating = False
On Error Resume Next
For i = 2 To 174
ActiveSheet.Pictures.Insert( _
"c:\Mr.BrownsPics\" & Cells(i, 3) & ".jpg").Select
With Selection.ShapeRange
.Top = Cells(i, 2).Top + 0.5
.Left = Cells(i, 2).Left + 0.5
.Width = Cells(i, 2).Width - 1
.Height = Cells(i, 2).Height - 1
.Name = Cells(i, 2)
End With
[A1].Select
If Err.Number > 0 Then
Cells(i, 2) = "nopic"
End If
Next i
Application.ScreenUpdating = True
End Sub

NOTE: Make sure that column "C" contains the names of the files.

No comments:

Post a Comment