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

How to insert a picture into Excel at a specified cell position with VBA

提问by Berker Yüceer

I'm adding ".jpg" files to my Excel sheet with the code below :

我正在使用以下代码将“.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

I don't know what I am doing wrong but it doesn't get inserted into the right cell, so what should I do to put this picture into a specified cell in Excel?

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

回答by SWa

Try this:

尝试这个：

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

It's better not to .select anything in Excel, it is usually never necessary and slows down your code.

最好不要在 Excel 中 .select 任何内容，这通常是不必要的，并且会减慢您的代码速度。

回答by Teamothy

Looking at posted answers I think this code would be also an alternative for someone. Nobody above used .Shapes.AddPicturein their code, only .Pictures.Insert()

查看已发布的答案，我认为此代码也是某人的替代方案。上面没有人.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

I'm working in Excel 2013. Also realized that You need to fill all the parameters in .AddPicture, because of error "Argument not optional". Looking at this You may ask why I set Heightand Widthas -1, but that doesn't matter cause of those parameters are set underneath between Withbrackets.

我在 Excel 2013 中工作。也意识到您需要填写所有参数.AddPicture，因为错误“参数不可选”。看看这个你可能会问为什么我设置Height和Width为-1，但这并不重要，因为这些参数设置在With括号之间。

Hope it may be also useful for someone :)

希望它对某人也有用:)

回答by Tristan

I have been working on a system that ran on a PC and Mac and was battling to find code that worked for inserting pictures on both PC and Mac. This worked for me so hopefully someone else can make use of it!

我一直在研究一个在 PC 和 Mac 上运行的系统，并且正在努力寻找可以在 PC 和 Mac 上插入图片的代码。这对我有用，所以希望其他人可以使用它！

Note: the strPictureFilePath and strPictureFileName variables need to be set to valid PC and Mac paths Eg

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

For PC: strPictureFilePath = "E:\Dropbox\" and strPictureFileName = "TestImage.jpg" and with Mac: strPictureFilePath = "Macintosh HD:Dropbox:" and strPictureFileName = "TestImage.jpg"

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

Code as Follows:

代码如下：

    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

回答by FCastro

If it's simply about inserting and resizing a picture, try the code below.

如果只是关于插入图片和调整图片大小，请尝试以下代码。

For the specific question you asked, the property TopLeftCell returns the range object related to the cell where the top left corner is parked. To place a new image at a specific place, I recommend creating an image at the "right" place and registering its top and left properties values of the dummy onto double variables.

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

Insert your Pic assigned to a variable to easily change its name. The Shape Object will have that same name as the Picture Object.

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

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

Good luck!

祝你好运！

回答by DrMarbuse

I tested both @SWa and @Teamothy solution. I did not find the Pictures.InsertMethod in the Microsoft Documentations and feared some compatibility issues. So I guess, the older Shapes.AddPictureMethod should work on all versions. But it is slow!

我测试了@SWa 和@Teamothy 解决方案。我Pictures.Insert在 Microsoft 文档中没有找到该方法，担心会出现一些兼容性问题。所以我想，旧的Shapes.AddPicture方法应该适用于所有版本。但是速度很慢！

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