将图像嵌入 Excel 电子表格 - VBA

Embed Image to Excel Spreadsheet - VBA

提问by RandomDude

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 this?

我需要通过 Excel VBA 将图像嵌入到电子表格中，这样每当我重新定位我的 excel 文件时，图像仍会显示。我怎样才能做到这一点？

回答by PaulStock

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

此代码将在当前工作表上插入一个图像并将其放置在单元格 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

回答by Reafidy

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 ExcelTipall credit to the original author Erlandsen Data Consulting.

还有大量使用谷歌搜索词的信息：“使用 VBA Excel 插入图片”。下面的代码取自ExcelTip，全部归功于原作者 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