VBA Code - Remove link to inserted pictures

[Spaztic]

I have VBA code (see below) that inserts a picture. The issue is that when I send the Excel file to someone else, the pictures do not show up and they get the error in place of the picture (see below image) when they open the Excel file. Is there something that can be put in the VBA code that 'de-links' the image from my directory?

Appreciate any help you can give me!

Sub InsertPic()

'Make all pictures move and size with cell
    Dim xPic As Picture
    On Error Resume Next
    Application.ScreenUpdating = False
    For Each xPic In ActiveSheet.Pictures
        xPic.Placement = xlMoveAndSize
    Next
    Application.ScreenUpdating = True


'Add picture...centered...scaled
    Dim fNameAndPath As Variant
    Dim rng As Range
    Dim img As Picture
  
    fNameAndPath = Application.GetOpenFilename( _
        FileFilter:="Image Files (*.gif;*.jpg;*.png), *.gif;*.jpg;*.png", _
        Title:="Select an Image", _
        ButtonText:="Select")
      
    If fNameAndPath = False Then Exit Sub
  
    Set rng = ActiveCell
  
    Set img = ActiveSheet.Pictures.Insert(fNameAndPath)
    With img
        If .Width > .Height Then
            .Width = rng.Width * 0.7
        Else
            .Height = rng.Height * 0.7
        End If
        .Left = rng.Left + (rng.Width - .Width) / 2
        .Top = rng.Top + (rng.Height - .Height) / 2
       .Placement = 1
       .PrintObject = True
    End With
  
End Sub

 

[Domenic]

It's likely due to a bug that exists with Pictures.Insert. Therefore, use the AddPicture method of the Shapes object instead. I've amended your code accordingly. You'll notice that img is now declared as Shape.

Sub InsertPic()

'Make all pictures move and size with cell
    Dim xPic As Picture
    On Error Resume Next
    Application.ScreenUpdating = False
    For Each xPic In ActiveSheet.Pictures
        xPic.Placement = xlMoveAndSize
    Next
    Application.ScreenUpdating = True


'Add picture...centered...scaled
    Dim fNameAndPath As Variant
    Dim rng As Range
    Dim img As Shape
 
    fNameAndPath = Application.GetOpenFilename( _
        FileFilter:="Image Files (*.gif;*.jpg;*.png), *.gif;*.jpg;*.png", _
        Title:="Select an Image", _
        ButtonText:="Select")
      
    If fNameAndPath = False Then Exit Sub
 
    Set rng = ActiveCell
 
    Set img = ActiveSheet.Shapes.AddPicture(Filename:=fNameAndPath, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=0, Top:=0, Width:=-1, Height:=-1)
    With img
        If .Width > .Height Then
            .Width = rng.Width * 0.7
        Else
            .Height = rng.Height * 0.7
        End If
        .Left = rng.Left + (rng.Width - .Width) / 2
        .Top = rng.Top + (rng.Height - .Height) / 2
       .Placement = 1
       .PrintObject = True
    End With
 
End Sub

Hope this helps!

 

[Spaztic]

This did the trick. Thank you for the quick answer as well!

 

[Domenic]

That's great, glad I could help.

Cheers!

 

[Artik]

It's likely due to a bug that exists with Pictures.Insert. Therefore, use the AddPicture method of the Shapes object instead.

Let me explain a bit.
Pictures.Insert creates a sub-linked image (to reduce the weight of the XLS file), while AddPicture embeds the image in the document (which of course increases the file weight by the weight of the image).

Artik

 

[Domenic]

Hi @Artik ,

Thanks for your comments.

Actually, in Excel 2007, it actually embeds the picture within the workbook. But, for some reason, in Excel 2010, its behaviour changed. As you've already mentioned, it links the image instead. It was my understanding at the time that it was a bug. But I may be mistaken.

In any case, since Pictures.Insert has been deprecated, I use Shapes.AddPicture instead, which as you know allows one to explicitly specify whether to embed or link the image.

Cheers!