Как вставить изображение в Excel в указанной ячейке с помощью VBA

Я добавляю файлы ".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?

Ответ 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, обычно это никогда не нужно и замедляет ваш код.

Ответ 2

Я работал над системой, которая работала на ПК и Mac, и боролась за поиск кода, который работал для вставки изображений на ПК и Mac. Это работало для меня так, надеюсь, кто-то другой сможет его использовать!

Примечание: переменные strPictureFilePath и strPictureFileName должны быть установлены на допустимые пути к ПК и Mac Eg

Для ПК: 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

Ответ 3

Если вы просто вставляете и изменяете размер изображения, попробуйте код ниже.

Для конкретного заданного вами вопроса свойство TopLeftCell возвращает объект диапазона, связанный с ячейкой, где расположен верхний левый угол. Чтобы разместить новое изображение в определенном месте, я рекомендую создать изображение в "правильном" месте и зарегистрировать его верхние и левые значения свойств манекена на двойные переменные.

Вставьте свой Pic, назначенный переменной, чтобы легко изменить его имя. Объект формы будет иметь то же имя, что и объект изображения.

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

Удачи!