To avoid having the picture show up on other sheets, you need to avoid inserting into the active sheet. Here's a modified version of the function, which also allows you to optionally shift the image horizontally or vertically (plus a few other improvements I've incorporated which I can't take credit for).
FYI, I used this as part of a scoring spreadsheet I created for my Cub Scout's Pinewood Derby. I took pictures of all the cars and was able to display them during each heat as the races progressed - worked awesome! This really made the spreadsheet - the boys and families loved it.
Thanks especially to the original author, Damon Ostrander, and others out there who have used and improved the function (especially PA HS Teacher).
~ Steve
Function ShowPicD(PicFile As String, _
Optional iWidth As Single = 118, _
Optional iHeight As Single = 89, _
Optional ShiftHorizontal As Single = 0, _
Optional ShiftVertical As Single = 0) As String
'Shows a picture and deletes previous picture when picfile changes.
'Adapted from ShowPicD code posted by Damon Ostrander, with special
'thanks to PA HS Teacher for some nice improvements.
'See
http://www.mrexcel.com/forum/showthread.php?t=100737
'and
http://www.mrexcel.com/forum/showthread.php?t=145913
'and
http://www.mrexcel.com/forum/showthread.php?t=145024
'Major modifications are as follows:
'1) Use correct variable types (Single) for width, etc.
'2) Width and height are optional (credit to PA HS Teacher).
'3) Enable user to just send in width or height, calculate other value
' assuming a 4x3 image.
'4) Add option to shift the image horizontally and vertically.
'5) Link to picture instead of embedding in the file - makes saves
' faster and reduces file size (credit to PA HS Teacher).
'6) Fix issue with picture showing up on other worksheets (credit to
' PA HS Teacher).
'7) Name the picture based on cell location so that we do not have to
' search for pictures by location.
'8) Return a String instead of a Boolean in order to display "No Image"
' in cell if no image exists.
'9) Probably a few other tweaks.
On Error GoTo Done
' Default to 4x3 image size if one of dimensions is specified as 0
' Note - if we wanted to generally scale the picture that can be
' done (instead of doing this) - see note on this further in the
' routine. We assume that the user will send in one of these values
' (not both as zero).
If iHeight = 0 Then
iHeight = 0.75 * iWidth
ElseIf iWidth = 0 Then
iWidth = 4 / 3 * iWidth
End If
'Look for a picture already over cell (note we name the picture based
'on cell location below so we can use the name as our search criteria)
Dim AC As Range
Set AC = Application.Caller
Dim SheetName As String
SheetName = AC.Parent.name
'Note - this will delete max of one existing picture over cell
Dim P As Shape
For Each P In Worksheets(SheetName).Shapes
If P.Type = msoLinkedPicture Then
If P.name = SheetName & "-" & CStr(AC.row) & ":" & CStr(AC.column) Then
P.Delete
Exit For
End If
End If
Next P
'Special case if picture file is blank - return empty string and exit
If PicFile = "" Then
ShowPicD = ""
Exit Function
End If
'Notes on AddPicture method:
'AC.Left = the position (in points) of the upper-left corner of the picture
'relative to the upper-left corner of the document.
'AC.Top = the position (in points) of the upper-left corner of the picture
'relative to the top of the document (thus we subtract ShiftVertical below
'instead of add it).
'The 3rd argument is set to false to save a link to the file, versus embedding
'in the Excel file - makes our files much smaller and saves much faster.
Set P = Worksheets(SheetName).Shapes.AddPicture(PicFile, msoCTrue, msoFalse, _
AC.left, AC.top, iWidth, iHeight)
'Shift the picture if needed. Note: Excel may not shift the picture
'exactly as we request - it can come out 0.2 off from where we want
'it. The original ShowPicD function searched for the previous picture
'based on location, which would fail due to this slight discrepancy.
'Thus we now name the picture based on cell location instead.
P.IncrementLeft ShiftHorizontal
P.IncrementTop -ShiftVertical
'Uncomment the code below to see the possible 0.2 shift mentioned above
'Dim err_left As Single, err_top As Single
'err_left = P.left - left
'err_top = P.top - top
'Dim result As Integer
'result = MsgBox("Image shift - " & PicFile & vbCrLf & _
' "Left = " & Str(err_left) & vbCrLf & "Top = " & Str(err_top))
'Name P based on calling cell location
'Note - I use CStr instead of Str as Str adds a space before the number
P.name = SheetName & "-" & CStr(AC.row) & ":" & CStr(AC.column)
'Note - another way to scale the image is to do the below (use this
'if you cannot live with the 4x3 image scaling earlier in the function),
'but this will be slightly slower as the picture will be scaled twice.
'P.ScaleHeight 1, msoCTrue
'P.ScaleWidth 1, True
'P.Height = iHeight
'Also can set P.Width instead
ShowPicD = ""
Exit Function
Done:
ShowPicD = "No Image"
End Function
