如何使用VBA将图片插入到Excel中特定单元格的位置

Question

我正在使用下面的代码向Excel表格中添加".jpg"文件：

'Add picture to excel
xlApp.Cells(i, 20).Select
xlApp.ActiveSheet.Pictures.Insert(picPath).Select
'Calgulate new picture size
With xlApp.Selection.ShapeRange
    .LockAspectRatio = msoTrue
    .Width = 75
    .Height = 100
End With
'Resize and make printable
With xlApp.Selection
    .Placement = 1 'xlMoveAndSize
    '.Placement = 2 'xlMove
    '.Placement = 3 'xlFreeFloating
    .PrintObject = True
End With

我不知道我在做什么错了，但它没有被插入到正确的单元格中，那么我应该怎么做才能将这张图片放入Excel中的指定单元格中呢？

- Berker Yüceer

---

你可以设置图片的TopLeftCell属性。 - Tim Williams

是的，在长时间的编程之后，有时候像这样简单的事情会变成一个大问题，你知道的... - Berker Yüceer

Answer 1

试试这个：

With xlApp.ActiveSheet.Pictures.Insert(PicPath)
    With .ShapeRange
        .LockAspectRatio = msoTrue
        .Width = 75
        .Height = 100
    End With
    .Left = xlApp.ActiveSheet.Cells(i, 20).Left
    .Top = xlApp.ActiveSheet.Cells(i, 20).Top
    .Placement = 1
    .PrintObject = True
End With

最好不要在Excel中选择任何内容，这通常是不必要的，并会减慢代码运行速度。

- SWa

---

对于来到这里的人，需要知道不同版本的 Excel 处理此请求的方式不同。Excel 2007 会将图片作为对象插入，即将其嵌入工作簿中。而Excel 2010 则会将其插入为链接，如果你计划将其发送给其他人，则会导致问题。你需要更改插入方式以指定它为嵌入式：Insert(Filename:=<path>, LinkToFile:=False, SaveWithDocument:=True)。 - BJury

Answer 2

看了已发布的答案，我认为这段代码也是另一种选择。以上没有人在他们的代码中使用 .Shapes.AddPicture，只有 .Pictures.Insert()

Dim myPic As Object
Dim picpath As String

picpath = "C:\Users\photo.jpg" 'example photo path

Set myPic = ws.Shapes.AddPicture(picpath, False, True, 20, 20, -1, -1)

With myPic
    .Width = 25
    .Height = 25
    .Top = xlApp.Cells(i, 20).Top 'according to variables from correct answer
    .Left = xlApp.Cells(i, 20).Left
    .LockAspectRatio = msoFalse
End With

我正在使用Excel 2013。我意识到你需要填写.AddPicture中的所有参数，否则会出现“Argument not optional”的错误。你可能会问为什么我将Height和Width设置为-1，但这并不重要，因为这些参数在With括号之间被设置。希望这对某人也有用 :)

- Teamothy

Answer 3

如果只是插入和调整图片，可以尝试以下代码。

对于您提出的具体问题，属性TopLeftCell返回与停放左上角的单元格相关的范围对象。为了将一个新图像放置在特定位置，建议在“正确”的位置创建一个图像，并将其顶部和左侧属性值注册到双变量上。

将您的图像分配给一个变量以轻松更改其名称。形状对象将具有与图片对象相同的名称。

Sub Insert_Pic_From_File(PicPath as string, wsDestination as worksheet)
    Dim Pic As Picture, Shp as Shape
    Set Pic = wsDestination.Pictures.Insert(FilePath)
    Pic.Name = "myPicture"
    'Strongly recommend using a FileSystemObject.FileExists method to check if the path is good before executing the previous command
    Set Shp = wsDestination.Shapes("myPicture")
    With Shp
        .Height = 100
        .Width = 75
        .LockAspectRatio = msoTrue  'Put this later so that changing height doesn't change width and vice-versa)
        .Placement = 1
        .Top = 100
        .Left = 100
    End with
End Sub

祝你好运！

- FCastro

---

FilePath 应该改成 PicPath 吗？还是反过来？ - Unicco

Answer 4

首先，我建议将图片放在与工作簿相同的文件夹中。 您需要在工作表的Worksheet_Change过程中输入一些代码。例如，我们可以输入以下代码，将与列A单元格值相同名称的图像添加到列D单元格中：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim pic As Picture
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
On Error GoTo son

For Each pic In ActiveSheet.Pictures
    If Not Application.Intersect(pic.TopLeftCell, Range(Target.Offset(0, 3).Address)) Is Nothing Then
        pic.Delete
    End If
Next pic

ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Target.Value & ".jpg").Select
Selection.Top = Target.Offset(0, 2).Top
Selection.Left = Target.Offset(0, 3).Left
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = Target.Offset(0, 2).Height
Selection.ShapeRange.Width = Target.Offset(0, 3).Width
son:

End Sub

使用上述代码，图片的大小会根据添加到的单元格进行调整。

详细信息和示例文件请参见：Vba Insert image to cell

- kadrleyn

---

几年前，那些(top, left)属性是个问题。不过感谢你提供了不同的方法。 - Berker Yüceer

Answer 5

我一直在开发一款能够在PC和Mac上运行的系统，并且苦于找不到适用于两个平台的插入图片的代码。这段代码对我很有用，希望其他人也能受益！

注意：strPictureFilePath和strPictureFileName变量需要设置为有效的PC和Mac路径，例如：

对于PC：strPictureFilePath = "E:\Dropbox\"，strPictureFileName = "TestImage.jpg"；对于Mac：strPictureFilePath = "Macintosh HD:Dropbox:"，strPictureFileName = "TestImage.jpg"。

代码如下：

    On Error GoTo ErrorOccured

    shtRecipeBrowser.Cells(intDestinationRecipeRowCount, 1).Select

    ActiveSheet.Pictures.Insert(Trim(strPictureFilePath & strPictureFileName)).Select

    Selection.ShapeRange.Left = shtRecipeBrowser.Cells(intDestinationRecipeRowCount, 1).Left
    Selection.ShapeRange.Top = shtRecipeBrowser.Cells(intDestinationRecipeRowCount, 1).Top + 10
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 130

- Tristan

Answer 6

我测试了@SWa和@Teamothy的解决方案。在Microsoft文档中，我没有找到方法，并担心一些兼容性问题。因此，我猜测旧的方法应该适用于所有版本。但是它很慢！

On Error Resume Next
'
' first and faster method (in Office 2016)
'
    With ws.Pictures.Insert(Filename:=imageFileName, LinkToFile:=msoTrue, SaveWithDocument:=msoTrue)
        With .ShapeRange
            .LockAspectRatio = msoTrue
            .Width = destRange.Width
            .height = destRange.height '222
        End With
        .Left = destRange.Left
        .Top = destRange.Top
        .Placement = 1
        .PrintObject = True
        .Name = imageName
    End With
'
' second but slower method (in Office 2016)
'

If Err.Number <> 0 Then
    Err.Clear
    Dim myPic As Shape
    Set myPic = ws.Shapes.AddPicture(Filename:=imageFileName, _
            LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
            Left:=destRange.Left, Top:=destRange.Top, Width:=-1, height:=destRange.height)

    With myPic.OLEFormat.Object.ShapeRange
        .LockAspectRatio = msoTrue
        .Width = destRange.Width
        .height = destRange.height '222
    End With
End If

- DrMarbuse

---

Pictures.Insert 定义在 Microsoft.Office.Interop.Excel 中。因此，在 VBA 中应该使用 Shapes.AddPicture 方法。 - DrMarbuse