How can i store pictues within a excel file then use showpic

[damianpadden]

I am trying to use Showpic to pull in a .gif file. What I would like to do is have all the gif files within my excel file and then refer to them rather that looking at my c drive. The code i have so far is below.

Function ShowPic(PicFile As String, celDestination As Range, DeltaPointX As Long, DeltaPointY As Long, SizePointX As Long, SizePointY As Long) As String

'Same as ShowPic except deletes previous picture when picfile changes
Dim AC As Range
Static P As Shape
Set AC = Application.Caller
If PicExists(P) Then
P.Delete
Else
'look for a picture already over cell
For Each P In ActiveSheet.Shapes
If P.Type = msoLinkedPicture Then
If P.Left >= AC.Left And P.Left < AC.Left + AC.Width Then
If P.Top >= AC.Top And P.Top < AC.Top + AC.Height Then
P.Delete
Exit For
End If
End If
End If
Next P
End If

Dim shp As Shape
On Error GoTo Errhandler
With celDestination
For Each shp In .Parent.Shapes
If shp.TopLeftCell.Address = celDestination.Address Then
shp.Delete
ElseIf Round(shp.Left) = Round(.Left + DeltaPointX) And Round(shp.Top) = Round(.Top + DeltaPointY) Then
shp.Delete
End If
Next
Set shp = .Parent.Shapes.AddPicture(PicFile, True, True, .Left + DeltaPointX, .Top + DeltaPointY, _
SizePointX, SizePointY)
End With
ShowPic = ""
Exit Function

Errhandler:
ShowPic = "Failed"
End Function


Function PicExists(P As Shape) As Boolean
'Return true if P references an existing shape
Dim ShapeName As String
On Error GoTo NoPic
If P Is Nothing Then GoTo NoPic
ShapeName = P.Name
PicExists = True
NoPic:
PicExists = False
End Function

 

[BrianB]

You may be interested in my answer here :-

http://www.mrexcel.com/board2/viewtopic.php?t=216914&highlight=addpicture

A simple way of viewing pictures from a worksheet is to run code from another worksheet that copy - paste - deletes each in turn. We can then have a different view size too - keeping the other set nicely arranged.