Keep images in an excel sheet while removing their link

I'm new to this forum and looked for an answer for my issue. Found a reply that I thought would fix it but not really...
I have a sheet with hundreds of images that are copied in a cell via a macro. The macro looks into a folder of images, ties the right image to the an item code and resizes the image to fit the cell. Working great!
I'm trying now to remove the links from the images in this sheet so that every image is part of the sheet and is not referred to via a link. The purpose for that is to be able to share the excel file without having to share the folder with all the images as well. Somehow the link remains active even if I run a macro to remove all links in the sheet. When I remove the folder and re-open the sheet, no images are shown. I just see square boxes with a comment that the link is pointing to a folder where the
Related image cannot be found...

Any solutions?

Dear Jacobshavn,

Please see below.

Macro - Link removal (not working on Microsoft Office Professional Plus 2010)



Sub DeleteObjectHyperlinks()

With ActiveSheet

For Each Shape In .Shapes

.Hyperlinks.Delete

Next Shape

End With

End Sub


Macro - Insert pictures from folder and adjust size to fit the cell. (Working fine)



Sub addPictures()

Dim pictureFolder As String

Dim picLocation As String

Dim startrow As Integer, codeCol As Integer, pictureCol As Integer, blank As Boolean

pictureFolder = "C:\Users\103018164\Documents\Netherlands Sales Office\Pricing\IMAGE_FILE_LOW\"

startrow = 12

codeCol = 2

pictureCol = 1

blank = False

Do

If IsEmpty(Cells(startrow, codeCol)) Then

blank = True

Else

picLocation = pictureFolder & Cells(startrow, codeCol) & ".jpg"

InsertPicture picLocation, Cells(startrow, pictureCol), True, True

Cells(startrow, pictureCol).Select

End If

startrow = startrow + 1

If startrow > 4064 Then Exit Do

Loop

End Sub

Sub InsertPicture(PictureFileName As String, TargetCell As Range, _

CenterH As Boolean, CenterV As Boolean)

' inserts a picture at the top left position of TargetCell

' the picture can be centered horizontally and/or vertically

Dim p As Object, t As Double, l As Double, w As Double, h As Double

' Check for valid parameters

If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub

If (Dir(PictureFileName) = "") Then Exit Sub

' MsgBox "|" & Dir(PictureFileName) & "|"

' import picture

Set p = ActiveSheet.Pictures.Insert(PictureFileName)

p.Select

With Selection.ShapeRange

.LockAspectRatio = msoTrue

If .Width > .Height Then

.Width = TargetCell.Width

If .Height > TargetCell.Height Then .Height = TargetCell.Height

Else

.Height = TargetCell.Height

If .Width > TargetCell.Width Then .Width = TargetCell.Width

End If

End With

If Dir(PictureFileName) = "" Then Exit Sub

' resize picture

p.Select

With Selection.ShapeRange

.LockAspectRatio = msoTrue

If .Width > .Height Then

.Width = TargetCell.Width

If .Height > TargetCell.Height Then .Height = TargetCell.Height

Else

.Height = TargetCell.Height

If .Width > TargetCell.Width Then .Width = TargetCell.Width

End If

End With

' determine positions

With TargetCell

t = .Top

l = .Left

If CenterH Then

w = .Offset(0, 1).Left - .Left

l = l + w / 2 - p.Width / 2

If l < 1 Then l = 1

End If

If CenterV Then

h = .Offset(1, 0).Top - .Top

t = t + h / 2 - p.Height / 2

If t < 1 Then t = 1

End If

End With

' position picture

With p

.Top = t

.Left = l

End With

' set picture properties

With Selection

.Placement = xlMoveAndSize

.PrintObject = True

End With

Set p = Nothing

End Sub

Check this out:

http://social.msdn.microsoft.com/For...-?forum=isvvba

I too am strugging with an insert images macro..