Unable to display pic
Closed
Hazlina94
Posts
3
Registration date
Wednesday February 22, 2017
Status
Member
Last seen
February 27, 2017
-
Feb 26, 2017 at 09:32 PM
Hazlina94 Posts 3 Registration date Wednesday February 22, 2017 Status Member Last seen February 27, 2017 - Feb 26, 2017 at 09:34 PM
Hazlina94 Posts 3 Registration date Wednesday February 22, 2017 Status Member Last seen February 27, 2017 - Feb 26, 2017 at 09:34 PM
Related:
- Unable to display pic
- Unable to ping computer on same network - Guide
- Tiktok unable to authorize twitter - TikTok Forum
- Unable to join whatsapp group ✓ - WhatsApp Forum
- Download mp3 with lyrics display - Download - Audio playback
- Unable to load authentication library exiting - Counter Strike (CS) Forum
1 response
Hazlina94
Posts
3
Registration date
Wednesday February 22, 2017
Status
Member
Last seen
February 27, 2017
Feb 26, 2017 at 09:34 PM
Feb 26, 2017 at 09:34 PM
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
