CODEWITHSUNDEEP
excelvba
theStupidOne
theStupidOne

Reputation: 57

save imported picture in excel using vba

So I have a macro assigned to a command button. when pressed it opens a dialogue box for user to import a picture file. Then it resizes the image and puts it on a specific cell. But If I move the original picture file location, the image disappears in Excel. Is there any chance I can save it inside the excel file so that it will not matter if I move the original file location.

The code is as follow:

    Sub Add_Image()
    Application.ScreenUpdating = False
    Range("B18").Select
    'varible Picture1 is inserted down below - ***change both***
    Picture1 = Application.GetOpenFilename("Picture,*.JPG,Picture,*.JPEG,Picture,*.GIF,Picture,*.BMP")
    'edit "("Picture,*.*")" section to add or chanve visible file types
    On Error GoTo ErrMsg
    ActiveSheet.Pictures.Insert(Picture1).Select
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.Height = 145
    Selection.ShapeRange.Width = 282
    Application.ScreenUpdating = True
    Exit Sub
ErrMsg:
    MsgBox ("Failed to load Image"), , "Error"
End Sub

Upvotes: 3

Views: 7654

Answers (2)

Rohit Jaiswal
Rohit Jaiswal

Reputation: 19

Adding to the answer by Chris, additionally, I wanted to maintain the aspect ratio of the downloaded image. The problem was the AddPicture method mandates the arguments for width and height both. The trick which worked was putting those values as "-1" and then changing only height with locked aspect ratio.

    Set picCell = cell.Offset(0, 1)

    Set pic = ActiveSheet.Shapes.AddPicture(fileString, False, True,_
          picCell.Left + 10, picCell.Top + 10, -1, -1)
    With pic
          .LockAspectRatio = msoTrue
          .Height = 200
    End With

Upvotes: 2

chris neilsen
chris neilsen

Reputation: 53166

.Pictures.Insert doesn't seem to provide control over linking or imbedding.

However you can use this instead

expression.AddPicture(Filename, LinkToFile, SaveWithDocument, Left, Top, Width, Height)

Sub Add_Image()
    Dim pic As Object
    Dim rng As Range

    Application.ScreenUpdating = False
    Set rng = Range("B18")
    Set rng2 = Range("A1", rng.Offset(-1, -1))
    'varible Picture1 is inserted down below - ***change both***
    Picture1 = Application.GetOpenFilename( _
        "Picture,*.JPG,Picture,*.JPEG,Picture,*.GIF,Picture,*.BMP")
    'edit "("Picture,*.*")" section to add or chanve visible file types

    On Error GoTo ErrMsg
    With Range("A1", rng.Offset(-1, -1))
        Set pic = ActiveSheet.Shapes.AddPicture(Picture1, False, True, _
            .Width, .Height, 282, 145)
    End With
    With pic
        .LockAspectRatio = msoFalse
    End With
    Application.ScreenUpdating = True
Exit Sub
ErrMsg:
    MsgBox ("Failed to load Image"), , "Error"
End Sub

Upvotes: 4

Related Questions