excel 2010 VBA InsertPicInRange only makes shortcut to image instead of copy of image

Hello Patel,

Thanks for your very quick reply.

But I think I was unclear in posting the complete script in the post.
The first portion is a test bit and not used anymore.

The problem lies in the second bit.
In the "Sub InsertPicInRange".
The "Sub TestInsertPicture" isn't used.

Sorry for the inconvenience.

Never the less I have tried your suggestion but it makes no difference.

Sub InsertPicInRange()
'
' InsertPicInRange Macro
' De macro is opgenomen op 24-6-2005 door sb.
'
' Sneltoets: CTRL+SHIFT+Q
'
Dim strRange As String
Dim strRange2 As String


strRange = "A12"
For I = 12 To 200
 strRange = "A" & I
 strRange2 = "B" & I & ":" & "B" & I
 InsertPictureInRange "t:\" & Worksheets("Offerte").Range(strRange), _
        Range(strRange2)

Next I


End Sub


Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
' 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 Sub
    If Dir(PictureFileName) = "t:\" Then Exit Sub
    If Right(PictureFileName, 4) <> ".jpg" Then PictureFileName = PictureFileName + ".jpg"
    'import picture
    On Error GoTo JUMPNEXT
    Set p = ActiveSheet.Pictures.Insert(PictureFileName)
    GoTo ENDSTATEMENT
    
JUMPNEXT:
    PictureFileName = "T:\" & Right(PictureFileName, 10)
    If Not IsNull(p) Then GoTo FIN Else GoTo ENDSTATEMENT
    
ENDSTATEMENT:
    ' determine positions
    'On Error GoTo FIN
    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
        .Top = t
        .Left = l
        .Width = w
        .Height = h
    End With
    Set p = Nothing

FIN:
End Sub

Originally Posted by ArjanSpit

The problem lies in the second bit.
In the "Sub InsertPicInRange".
The "Sub TestInsertPicture" isn't used.

you have to run Sub TestInsertPicture(), not other sub, don't mix my code with your.