Unable to display pic

[Closed]
Report
Posts
3
Registration date
Wednesday February 22, 2017
Status
Member
Last seen
February 27, 2017
-
Posts
3
Registration date
Wednesday February 22, 2017
Status
Member
Last seen
February 27, 2017
-



Already Macro enable,picture display issue message is "The Linked image cannot be displayed. The file may have been moved, renamed or deleted. Verify that the link points to the correct file and location working fine on windows platform but not on MAC laptop"

1 reply

Posts
3
Registration date
Wednesday February 22, 2017
Status
Member
Last seen
February 27, 2017

VB Script as below :


Function ShowPicD(PicFile As String) As Boolean
'Same as ShowPic except deletes previous picture when picfile changes
Dim AC As Range
Static P As Shape
Dim VShft As Integer, HShft As Integer
VShft = Range("W6") 'amount to shift picture up or down
HShft = Range("W5") ' amount to shift picture left or right
On Error GoTo Done
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 + HShft And P.Left < AC.Left + HShft + AC.Width Then
If P.Top >= AC.Top + VShft And P.Top < AC.Top + VShft + AC.Height Then
P.Delete
Exit For
End If
End If
End If
Next P
End If
Set P = ActiveSheet.Shapes.AddPicture(Path + "\" + FileName + Extention, True, False, AC.Left + HShft, AC.Top + VShft, 100, 100) '200 x 200 pixels, change to desired size
P.Select
Selection.ShapeRange.ZOrder msoBringToFront
Selection.ShapeRange.Shadow.Visible = msoFalse
ShowPicD = True
Exit Function
Done:
ShowPicD = False
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