Macro for embedding images vs inserting

[luke4541]

Hi,
I am trying to make a macro that will embed images into a worksheet for my company. I researched online and put one together from stuff I've seen posted but when I email the file, the receiver can not see the image. I believe it is because "inserting" a picture only inserts a link to the picture but not the actual picture. Is there a way to embed the picture using the same macro without the sender having to send the picture and the worksheet?

Sub photo1()
'
' photo1 Macro
'
'

Application.ScreenUpdating = False
'varible Picture1 is inserted down below - ***change both***
Picture1 = Application.GetOpenFilename("Picture,*.JPG,Picture,*.JPEG,Picture,*.GIF,Picture,*.BMP")
'edit "("Picture,*.*")" section to add or chanve visible file types

Range("c1419:i1434").Select
ActiveSheet.Pictures.Insert(Picture1).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 204
Selection.ShapeRange.Width = 225
Application.ScreenUpdating = True

End Sub

Thank you inadvance for any help you can give

 

[dazman85]

Try this:-

Dim PicLocation As String
Dim MyRange As String

MyRange = Selection.Address

PicLocation = Application.GetOpenFilename(strFileType, , _
Title, , MultiSelect)
If PicLocation <> "False" Then
Sheets("Sheet1").Pictures.Insert(PicLocation).Select
Else
Exit Sub
End If

With Selection.ShapeRange
.LockAspectRatio = msoTrue
If .Width > .Height Then
.Width = Range(MyRange).Width
If .Height > Range(MyRange).Height Then .Height = Range(MyRange).Height
Else
.Height = Range(MyRange).Height
If .Width > Range(MyRange).Width Then .Width = Range(MyRange).Width
End If
End With

With Selection
.Placement = xlMoveAndSize
.PrintObject = True
End With