I'm using a macro to insert a photo in to a Excel 2010 workbook.
If the photo moves location it will no longer display the photo in the document as I belive the photo is being referenced instead of embeded.
If you then use the "Change Picture" icon the photo embeds but how do I get my macro to embed the photo, please, please help?
Sub InsertPhoto(PictNo)
Dim SH As Worksheet
Dim Rng As Range
Dim MyPic As Picture
Dim sPath As String
Dim PicH As Single
Dim PicW As Single
Dim PicL As Single
Dim PicD As Single
PicNo = 1
If PictNo = 1 Then
PicL = 5
PicD = 130
End If
If PictNo = 2 Then
PicL = 440
PicD = 311
End If
If PictNo = 3 Then
PicL = 56
PicD = 567
End If
If PictNo = 4 Then
PicL = 440
PicD = 567
End If
PicH = 240
PicW = 320
Set SH = ActiveSheet
Set Rng = SH.Range("A1")
mypicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif),*.gif; *.jpg; *.bmp; *.tif", , "Select Picture to Import")
If Right(sPath, 1) <> "\" Then
sPath = sPath & "\"
End If
Range("b2").Select
Set MyPic = SH.Pictures.Insert(mypicture)
With MyPic
.Height = PicH
.Width = PicW
.Left = PicL
.Top = PicD
.SendToBack
.Select
End With
With Selection.ShapeRange.PictureFormat
.Brightness = 0.5
.Contrast = 0.5
.ColorType = msoPictureAutomatic
.CropLeft = 0#
.CropRight = 0#
.CropTop = 0#
.CropBottom = 0#
End With
Selection.ShapeRange.AlternativeText = ""
End Sub
If the photo moves location it will no longer display the photo in the document as I belive the photo is being referenced instead of embeded.
If you then use the "Change Picture" icon the photo embeds but how do I get my macro to embed the photo, please, please help?
Sub InsertPhoto(PictNo)
Dim SH As Worksheet
Dim Rng As Range
Dim MyPic As Picture
Dim sPath As String
Dim PicH As Single
Dim PicW As Single
Dim PicL As Single
Dim PicD As Single
PicNo = 1
If PictNo = 1 Then
PicL = 5
PicD = 130
End If
If PictNo = 2 Then
PicL = 440
PicD = 311
End If
If PictNo = 3 Then
PicL = 56
PicD = 567
End If
If PictNo = 4 Then
PicL = 440
PicD = 567
End If
PicH = 240
PicW = 320
Set SH = ActiveSheet
Set Rng = SH.Range("A1")
mypicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif),*.gif; *.jpg; *.bmp; *.tif", , "Select Picture to Import")
If Right(sPath, 1) <> "\" Then
sPath = sPath & "\"
End If
Range("b2").Select
Set MyPic = SH.Pictures.Insert(mypicture)
With MyPic
.Height = PicH
.Width = PicW
.Left = PicL
.Top = PicD
.SendToBack
.Select
End With
With Selection.ShapeRange.PictureFormat
.Brightness = 0.5
.Contrast = 0.5
.ColorType = msoPictureAutomatic
.CropLeft = 0#
.CropRight = 0#
.CropTop = 0#
.CropBottom = 0#
End With
Selection.ShapeRange.AlternativeText = ""
End Sub