如何使用VBA在指定的单元格位置将图片插入Excel

Question

我正在将".jpg"文件添加到我的Excel工作表中,代码如下:

'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中的指定单元格？

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中选择任何内容,通常不需要它并减慢代码速度.

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，因为错误“参数不可选”。看看这个你可能会问为什么我设置Height和Width为-1，但这并不重要，因为这些参数设置在With括号之间。

希望它对某人也有用:)

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

祝你好运！