Сохранить изображение в Excel с помощью VBA - PullRequest
2 голосов
/ 27 марта 2020

У меня на работе одна ситуация, когда людям приходится вручную вводить картинки на определенной странице Excel и изменять их размер вручную. Как начинающий, мне удалось найти некоторый код VBA, чтобы помочь представить картинку, нажав кнопку и вставив ее в определенный диапазон ячеек. Проблема, с которой я столкнулся, заключается в том, что я не могу понять (после поиска во многих сообщениях), как правильно ввести функцию сохранения изображения, не делая ссылки на него, чтобы другие могли видеть отчет, не получая ошибки, что изображение не существует .

Не могли бы вы помочь мне и указать, где должна быть введена эта функция?

Private Sub CommandButton3_Click()
Dim strFileName As String
Dim objPic As Picture
Dim rngDest As Range
strFileName = Application.GetOpenFilename( _
    FileFilter:="Images (*.jpg;*.gif;*.png),*.jpg;*.gif;*.png", _
    Title:="Please select an image...")
If strFileName = "False" Then Exit Sub
Set rngDest = Me.Range("B24:C26")
Set objPic = Me.Pictures.Insert(strFileName)
With objPic
    .ShapeRange.LockAspectRatio = msoFalse
    .Left = rngDest.Left
    .Top = rngDest.Top
    .Width = rngDest.Width
    .Height = rngDest.Height
End With
End Sub

Заранее спасибо!

1 Ответ

3 голосов
/ 27 марта 2020

Попробуйте это:

Private Sub CommandButton3_Click()
    Dim strFileName As String
    Dim objPic As Shape '<<<
    Dim rngDest As Range
    strFileName = Application.GetOpenFilename( _
        FileFilter:="Images (*.jpg;*.gif;*.png),*.jpg;*.gif;*.png", _
        Title:="Please select an image...")
    If strFileName = "False" Then Exit Sub
    Set rngDest = Me.Range("B24:C26")

     Set objPic = Me.Shapes.AddPicture(Filename:=strFileName, _
                                       linktofile:=msoFalse, _
                                       savewithdocument:=msoCTrue, _
                                       Left:=rngDest.Left, Top:=rngDest.Top, _
                                       Width:=rngDest.Width, Height:=rngDest.Height)

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...