Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Excel VBA - Insert image (using dialog box) into a certain cell

Tags:

excel

vba

So I've extensively searched through here and the various websites on the interwebs, but I'm having difficulty finding an answer. I'm also not the most VBA-savvy user.

Basically, what I need: On a button click, the "Insert Image" dialog box pops up, the user selects a single image file, and the image should be inserted into cell B2. Ideally I would like to size this image so that it isn't any longer than X, and no taller than Y.

This is my code so far (which gives me a 'Run-time error 424' and points to the TextBox1.Value line). Any suggestions/improvements are always greatly appreciated!

Sub ChangeImage()

With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.ButtonName = "Submit"
.Title = "Select an image file"
.Filters.Clear
.Filters.Add "JPG", "*.JPG"
.Filters.Add "JPEG File Interchange Format", "*.JPEG"
.Filters.Add "Graphics Interchange Format", "*.GIF"
.Filters.Add "Portable Network Graphics", "*.PNG"
.Filters.Add "Tag Image File Format", "*.TIFF"
.Filters.Add "All Pictures", "*.*"

If .Show = -1 Then
    TextBox1.Value = .SelectedItems(1)
    Image1.PictureSizeMode = fmPictureSizeModeZoom
    Image1.Picture = LoadPicture(.SelectedItems(1))

Else
    MsgBox ("Cancelled.")
End If
End With
End Sub

Thanks!

-A

like image 529
AllysonL Avatar asked Mar 12 '14 15:03

AllysonL


1 Answers

Here is one way of doing this with a different type of insertion. Example also show how to position and scale the image.

Sub ChangeImage()
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .ButtonName = "Submit"
        .Title = "Select an image file"
        .Filters.Clear
        .Filters.Add "JPG", "*.JPG"
        .Filters.Add "JPEG File Interchange Format", "*.JPEG"
        .Filters.Add "Graphics Interchange Format", "*.GIF"
        .Filters.Add "Portable Network Graphics", "*.PNG"
        .Filters.Add "Tag Image File Format", "*.TIFF"
        .Filters.Add "All Pictures", "*.*"

        If .Show = -1 Then
            Dim img As Object
            Set img = ActiveSheet.Pictures.Insert(.SelectedItems(1))

            'Scale image size
            'img.ShapeRange.ScaleWidth 0.75, msoFalse, msoScaleFromTopLeft
            'img.ShapeRange.ScaleHeight 0.75, msoFalse, msoScaleFromTopLeft

            'Position Image
            img.Left = 50
            img.Top = 150

            'Set image sizes in points (72 point per inch)
            img.Width = 150
            img.Height = 150
        Else
            MsgBox ("Cancelled.")
        End If
    End With
End Sub
like image 169
Automate This Avatar answered Sep 20 '22 22:09

Automate This