cocopops2001
Board Regular
- Joined
- Apr 18, 2011
- Messages
- 112
I have a problem with an OnError statement within my code.
What I would like is for my code to run a loop and extract a filename using the information in columns 1 and 2 of specific range and then insert this picture into the last column of same range. This bit works fine.
If the file cannot be found then I would like the last column to say "No Photo Found". This partially works as the No Photo Found appears in row 2 of my range but from then on I get the error 'unable to get the Insert property of the Picture class'. I know this is because the file is not available but in this case it should be putting "No Photo Found" into the cell instead of the picture.
Code below. Any help would be great.
What I would like is for my code to run a loop and extract a filename using the information in columns 1 and 2 of specific range and then insert this picture into the last column of same range. This bit works fine.
If the file cannot be found then I would like the last column to say "No Photo Found". This partially works as the No Photo Found appears in row 2 of my range but from then on I get the error 'unable to get the Insert property of the Picture class'. I know this is because the file is not available but in this case it should be putting "No Photo Found" into the cell instead of the picture.
Code below. Any help would be great.
Code:
Sub RefreshList()
Application.ScreenUpdating = False
Range("B4").Select
Selection.End(xlDown).Select
EndRow = Selection.Row
Range("B4:H" & EndRow).Select
With Selection
ActiveWorkbook.Names.Add Name:="StaffList", RefersTo:=Range("B4:H" & EndRow)
End With
With Range("Stafflist")
.Rows(RowNum).RowHeight = 130#
End With
Range("H4").Select
Range("H4:H" & EndRow).Select
With Selection
ActiveWorkbook.Names.Add Name:="PhotoRange", RefersTo:=Range("H4:H" & EndRow)
End With
RowNum = 1
PicInsert:
Do While Range("stafflist").Cells(RowNum, 1) <> 0
'On Error GoTo ErrNoPhoto:
Dim picname As String
picname = Range("Stafflist").Cells(RowNum, 1) & " " & Range("Stafflist").Cells(RowNum, 2) 'This is the picture name
On Error GoTo ErrNoPhoto:
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1) & "_Photos\" & picname & ".jpg").Select 'Path to where pictures are stored
With Selection
.ShapeRange.LockAspectRatio = msoTrue
.ShapeRange.Height = 120#
.ShapeRange.Rotation = 0#
.Top = Range("StaffList").Cells(RowNum, 7).Top
.Left = Range("StaffList").Cells(RowNum, 7).Left
.Placement = xlMoveAndSize
.Name = picname
End With
RowNum = RowNum + 1
Loop
Application.ScreenUpdating = True
Exit Sub
ErrNoPhoto:
Range("StaffList").Cells(RowNum, 7) = "No Photo Found"
RowNum = RowNum + 1
GoTo PicInsert
Exit Sub
Application.ScreenUpdating = True
End Sub