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

我正在使用Excel2013。还意识到您需要填写.AddPicture中的所有参数，因为错误“参数不是可选的”。对此，您可能会问为什么我将Height和Width设置为-1，但这没关系，因为这些参数设置在With括号之间。

希望它对某人也可能有用：）

Answer 3

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

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

对于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

Answer 4

如果只是插入图片并调整图片大小，请尝试下面的代码。

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

插入分配给变量的Pic以轻松更改其名称。 Shape对象将具有与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

祝你好运！

Answer 5

首先，我建议图片和工作簿在同一个文件夹中。您需要在工作表的 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

Answer 6

我测试了@SWa和@Teamothy解决方案。我没有在Microsoft文档中找到Pictures.Insert方法，并且担心一些兼容性问题。因此，我猜想，较旧的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

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

6 个答案: