kumar lama
Board Regular
- Joined
- May 20, 2014
- Messages
- 85
I Got this error in excel 2013, previously i was working in excel 2007, the code was working perfectly. in excel 2013 i receive this massage " The Linked image cannot be displayed the file may have been moved, rename Or Delete. Verify that the link points to the correct file and location.
I have Below Code. How can i fix It? Pls Help Me
Thank You!!
Option Explicit
Sub just4you()
Dim objNewPic As Object
Dim picToOpen As String
On Error Resume Next
' Setting Of picToopen String As The Application That Will Open The Picture
picToOpen = Application _
.GetOpenFilename("Pics (*.jpg), *.jpg")
If picToOpen <> False Then
' Setting The Opened Picture Into A Cell Range
Set objNewPic = InsertPictureInRange(picToOpen, _
Range("A1:H19"))
End If
End Sub
Function InsertPictureInRange(PictureFileName As String, TargetCells As Range) As Object
' inserts a picture and resizes it to fit the TargetCells range
Dim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Function
If Dir(PictureFileName) = "" Then Exit Function
' import picture
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
' determine positions
With TargetCells
t = .Top
l = .Left
w = .Offset(0, .Columns.Count).Left - .Left
h = .Offset(.Rows.Count, 0).Top - .Top
End With
' position picture
With p
.ShapeRange.LockAspectRatio = msoFalse
'my code
.Left = Range("K5").Left
.Top = Range("K5").Top
'your code....
.ShapeRange.Width = 85#
.ShapeRange.Height = 100#
End With
Set InsertPictureInRange = p
Set p = Nothing
End Function
I have Below Code. How can i fix It? Pls Help Me
Thank You!!
Option Explicit
Sub just4you()
Dim objNewPic As Object
Dim picToOpen As String
On Error Resume Next
' Setting Of picToopen String As The Application That Will Open The Picture
picToOpen = Application _
.GetOpenFilename("Pics (*.jpg), *.jpg")
If picToOpen <> False Then
' Setting The Opened Picture Into A Cell Range
Set objNewPic = InsertPictureInRange(picToOpen, _
Range("A1:H19"))
End If
End Sub
Function InsertPictureInRange(PictureFileName As String, TargetCells As Range) As Object
' inserts a picture and resizes it to fit the TargetCells range
Dim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Function
If Dir(PictureFileName) = "" Then Exit Function
' import picture
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
' determine positions
With TargetCells
t = .Top
l = .Left
w = .Offset(0, .Columns.Count).Left - .Left
h = .Offset(.Rows.Count, 0).Top - .Top
End With
' position picture
With p
.ShapeRange.LockAspectRatio = msoFalse
'my code
.Left = Range("K5").Left
.Top = Range("K5").Top
'your code....
.ShapeRange.Width = 85#
.ShapeRange.Height = 100#
End With
Set InsertPictureInRange = p
Set p = Nothing
End Function
