brettdemon
New Member
Hi all,
I was turned on to you through a friend at work. I am hoping you can help.
I am new to VBA and am having a lot of fun learning but I cannot figure this out.
What I am trying to do is really simple. I have a picture name starting in A1 (these include a .jpg at the end) and continue down thru A11. These names are identical to what is in the C: Drive folder "PICTURES". I want the picture to appear in C1 and continue down.
I have a macro that I believe is very close to working but I am getting a Run-time error '1004' on the line that reads n.Name = picname & ".jpg". I am seeing this as I use F8 to go thru the code. Any help that you can give would be greatly appreciated. Here is the code.
I was turned on to you through a friend at work. I am hoping you can help.
I am new to VBA and am having a lot of fun learning but I cannot figure this out.
What I am trying to do is really simple. I have a picture name starting in A1 (these include a .jpg at the end) and continue down thru A11. These names are identical to what is in the C: Drive folder "PICTURES". I want the picture to appear in C1 and continue down.
I have a macro that I believe is very close to working but I am getting a Run-time error '1004' on the line that reads n.Name = picname & ".jpg". I am seeing this as I use F8 to go thru the code. Any help that you can give would be greatly appreciated. Here is the code.
Code:
Sub Picture()
Dim picname As String
Dim pasteAt As Integer
Dim lThisRow As Long
Dim n
'Application.ScreenUpdating = False
lThisRow = 1
Do While (Cells(lThisRow, 1) <> "")
picname = Cells(lThisRow, 1) 'This is the picture name
Cells(lThisRow, 3).Select 'This is where picture will be inserted
Set n = ActiveSheet.Pictures.Insert("C:\Users\bcurran\Desktop\PICTURES" & picname & ".jpg") 'Path to where pictures are stored
n.Name = picname & ".jpg"
ActiveSheet.Shapes(picname & ".jpg").Select
With Selection
'.Left = Range("C1").Left
'.Top = Range("C1").Top
'.Left = Cells(pasteAt, 1).Left
'.Top = Cells(pasteAt, 1).Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 100#
.ShapeRange.Width = 80#
.ShapeRange.Rotation = 0#
End With
lThisRow = lThisRow + 1
Loop
Range("A11").Select
Application.ScreenUpdating = True
MsgBox "The dishes are done dude!"
Exit Sub
ErrNoPhoto:
MsgBox "Unable to Find Photo" 'Shows message box if picture not found
Exit Sub
End Sub