Unable to display pic
Closed
Hazlina94
Posts
3
Registration date
Wednesday 22 February 2017
Status
Member
Last seen
27 February 2017
-
26 Feb 2017 à 21:32
Hazlina94 Posts 3 Registration date Wednesday 22 February 2017 Status Member Last seen 27 February 2017 - 26 Feb 2017 à 21:34
Hazlina94 Posts 3 Registration date Wednesday 22 February 2017 Status Member Last seen 27 February 2017 - 26 Feb 2017 à 21:34
Related:
- Unable to display pic
- Realplayer unable to download - Guide
- Unable to authorize tiktok - TikTok Forum
- Internet explorer cannot display the webpage - Guide
- Laptop display upside down - Guide
- Display top fan badge - Guide
1 response
Hazlina94
Posts
3
Registration date
Wednesday 22 February 2017
Status
Member
Last seen
27 February 2017
26 Feb 2017 à 21:34
26 Feb 2017 à 21:34
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
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
