Embed Image to Excel Spreadsheet - VBA

I need to embed an image to a spreadsheet via Excel VBA, such that whenever I relocate my excel file, the image will still show up. How can I do 开发者_Python百科this?

This code will insert an image on the current sheet and position it at at cell E10:

Set oPic = Application.ActiveSheet.Shapes.AddPicture("d:\temp\mypic.jpg", False, True, 1, 1, 1, 1)
oPic.ScaleHeight 1, True
oPic.ScaleWidth 1, True

oPic.Top = Range("E10").Top
oPic.Left = Range("E10").Left

Did you try using the macro recorder?

This is what it produced for me:

Sub Macro1()

  ActiveSheet.Pictures.Insert ("C:\mypicture.jpg")

End Sub

Also tons of info using google search terms: "Insert Picture Using VBA Excel". The below code is taken from ExcelTip all credit to the original author Erlandsen Data Consulting.

With the macro below you can insert pictures at any range in a worksheet and they will remain as long as the picture itself remains in its original location.

The picture can be centered horizontally and/or vertically.

Sub TestInsertPicture()
    InsertPicture "C:\FolderName\PictureFileName.gif", _
        Range("D10"), True, True
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
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    If Dir(PictureFileName) = "" Then Exit Sub
    ' import picture
    Set p = ActiveSheet.Pictures.Insert(PictureFileName)
    ' 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 p = Nothing
End Sub

With the macro below you can insert pictures and fit them to any range in a worksheet.

Sub TestInsertPictureInRange()
    InsertPictureInRange "C:\FolderName\PictureFileName.gif", _
        Range("B5:D10")
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) = "" Then Exit Sub
    ' import picture
    Set p = ActiveSheet.Pictures.Insert(PictureFileName)
    ' determine positions
    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
End Sub