Link to home
Start Free TrialLog in
Avatar of Jonathan Mori
Jonathan MoriFlag for United States of America

asked on

Macro to click a button and insert image - Excel

Hi, I was wondering if there is a macro that can have an area in excel, you can click it and it would automatically bring up the image insert dialog and automatically insert the image in that area.
Example with the image attached. I want the user to click within those merged cells and be able to insert an image in that area.
User generated image
Avatar of byundt
byundt
Flag of United States of America image

I suggest not triggering the macro by clicking on a merged cell range--because then you couldn't edit that range. Instead, consider triggering the macro by double-clicking or right-clicking a merged cell range.

The following code assumes that you want to trigger the macro by double-clicking a merged cell range. The macro will then run automatically, and display the Insert Picture dialog. This code must be installed in the ThisWorkbook code pane. It won't work at all if installed anywhere else.
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Target.MergeCells Then
    Cancel = True
    Application.Dialogs(xlDialogInsertPicture).Show
End If
End Sub

Open in new window

Brad
Avatar of Jonathan Mori

ASKER

Oh thanks! I'm so sorry but I should have asked this with the first question. Is there a way that the picture can be fitted into the size of the merged cells?
That's possible too. Note that objects with fixed aspect ratio will leave a white band at either right or bottom of merged cell range. The code turns that setting off so the picture fills the merged cell range.
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim pix As Shape
Dim nShapes As Long
Dim sngWidth As Single, sngHeight As Single
Dim rw As Range, col As Range
If Target.MergeCells Then
    Cancel = True
    nShapes = Sh.Shapes.Count
    If Application.Dialogs(xlDialogInsertPicture).Show Then
        Application.ScreenUpdating = False
        For Each col In Target.Columns
            sngWidth = sngWidth + col.Width
        Next
        For Each rw In Target.Rows
            sngHeight = sngHeight + rw.Height
        Next
        Set pix = Sh.Shapes(nShapes + 1)
        pix.LockAspectRatio = msoFalse  'If you want to preserve the aspect ratio, use msoTrue--and will get white band at right or bottom
        pix.Width = sngWidth
        pix.Height = sngHeight
        Target.Select
    End If
End If
End Sub

Open in new window

Hmm, I doesn't seem to be working. :/ I am using excel 2010
I too am using Excel 2010, and the code is most definitely working for me using the pictures in the Sample Pictures folder.

Try testing the sample workbook attached.

Brad
Double-click-to-insert-pictureQ2.xlsm
Oh yes, I apologize it is working. It is just not working on my particular form for some reason. I will figure out why.
I'd be glad to look at your workbook if you post it, or send it to me (my email address is in my screen profile).

Brad
Ok thanks! I attached the sheet. The photo merged cells start on page 6
There is no attachment.

Attaching a file is a four step process:
1. Click the Attach File link in the new Comment pane
2. Use Windows Explorer to find the file, then click 'Open'
3. Click the Attach button in the new Comment pane
4. Add a few words of description
oh sorry, I thought I did that
ChesWellSiteChecklist-Tab.xlsm
I can reproduce your problem. Apparently, the newly added picture is not returned by Sh.Shapes(nShapes + 1). I have an alternative way of adding a picture that allows me to finesse the problem, but won't be able to code it until this evening.

Brad
OK, thank you! I will mess around with it too
The approach I was going to use was with Application.GetSaveAsFilename to let the user pick the picture, then use Sh.Shapes.AddPicture method to add and size the picture.
Here is the macro modified as described. I decided to use Application.GetOpenFilename because the Open button looks better to the user than the Save button.
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim pix As Shape
Dim flPath As String
Dim nShapes As Long
Dim sngWidth As Single, sngHeight As Single
Dim rw As Range, col As Range
If Target.MergeCells Then
    Cancel = True
    nShapes = Sh.Shapes.Count
    flPath = Application.GetOpenFilename(FileFilter:="Picture file (*.jpg),*.jpg", _
                Title:="Please choose a picture file, then click 'Open'")
    If flPath <> "False" Then
        Application.ScreenUpdating = False
        For Each col In Target.Columns
            sngWidth = sngWidth + col.Width
        Next
        For Each rw In Target.Rows
            sngHeight = sngHeight + rw.Height
        Next
        Set pix = Sh.Shapes.AddPicture(flPath, msoFalse, msoTrue, _
            Left:=Target.Left, Top:=Target.Top, Width:=sngWidth, Height:=sngHeight)
        pix.LockAspectRatio = msoFalse  'If you want to preserve the aspect ratio, use msoTrue--and will get white band at right or bottom
        Target.Select
    End If
End If
End Sub

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of byundt
byundt
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Sorry for the delay in response. Thanks so much for your help! It worked perfectly!