macro to load a picture

[deepfuntazii]

Hi guys please help a macro that can load picture automatically on excel

here is the sample link

http://img802.imageshack.us/img802/8159/cnub.png

apologize if there is already related post regarding this

 

[kevatarvind]

Here is the macro that I use :

Option Explicit
Sub Insert_Pic()
Dim filename As String
Dim picpath As String
picpath = "D:\Images\"
Range("A1").Select
filename = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
On Error Resume Next
ActiveSheet.Pictures.Insert(picpath + filename + ".jpg").Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 100
Selection.ShapeRange.Width = 134
Selection.Cut
ActiveSheet.Paste
ActiveCell.RowHeight = 100
ActiveCell.ColumnWidth = 25
End Sub

here is the link for the pictures (2 pictures) :

2013-07-10 28 photo, picture, image on Use.com

check the highlighted is missing

 

[deepfuntazii]

check the highlighted is missing

Hi Keva, the macro can only load 1 picture, if I give more than 1 style code than its not working..
please see below link
http://www.use.com/supersize.pl?set=b57e698a4c95e5e1198c

 

[kevatarvind]

TRY BELOW CODE

Option Explicit
Sub INSERT_PICTURES()
Dim i As Integer
Dim path As String
Dim mypath As String
path = "D:\Images\"
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
    mypath = path + Cells(i, 1) + ".jpg"
    If Dir(mypath, vbDirectory) <> "" Then
        Rows(i).RowHeight = 100
        Columns(2).ColumnWidth = 25
        Cells(i, 2).Select
        ActiveSheet.Pictures.Insert(path + Cells(i, 1) + ".jpg").Select
        Selection.ShapeRange.LockAspectRatio = msoFalse
        Selection.ShapeRange.Height = 99
        Selection.ShapeRange.Width = 134
        Selection.Cut
        ActiveSheet.Paste
     End If
Next
Cells(1, 1).Select
End Sub

 

[deepfuntazii]

try below code

option explicit
sub insert_pictures()
dim i as integer
dim path as string
dim mypath as string
path = "d:\images\"
for i = 2 to range("a" & rows.count).end(xlup).row
    mypath = path + cells(i, 1) + ".jpg"
    if dir(mypath, vbdirectory) <> "" then
        rows(i).rowheight = 100
        columns(2).columnwidth = 25
        cells(i, 2).select
        activesheet.pictures.insert(path + cells(i, 1) + ".jpg").select
        selection.shaperange.lockaspectratio = msofalse
        selection.shaperange.height = 99
        selection.shaperange.width = 134
        selection.cut
        activesheet.paste
     end if
next
cells(1, 1).select
end sub

thankx alot kevra it's working perfectly good jobs for you