Add image command button

[OKCIrish]

Hello,

I need help modifying this VBA code. I currently have a button command in the middle of the square, and anytime I push it, select my picture to use it throws it on a different page. What do I need to modify in order to have it drop the picture into the square that the command button resides in?

Book1
	A	B	C	D	E	F	G	H	I	J	K	L
1
2
3			Images
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Images

Sub CommandButton1_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 = Worksheets("Images").Range("B10:F17")
    Set objPic = Worksheets("Images").Pictures.Insert(strFileName)
    With objPic
        .ShapeRange.LockAspectRatio = msoTrue
        .Left = rngDest.Left
        .Top = rngDest.Top
        .Width = rngDest.Width
        .Height = rngDest.Height
    End With
End Sub

 

[Wookiee]

When you say that the macro throws your image on a different page, do you mean from a print layout perspective?

I tested the macro and it was putting the image in the correct location in my "Images" sheet. But in my testing, I noticed some things that might be of use to you.

First, the ShapeRange.LockAspectRatio property never affected any pictures whether I left it in or commented it out. Sad that, because I initially felt that was going to be the key.

The .Left and .Top properties work (for me, at least) as expected, anchoring the image to the top left cell. But I noticed that you can either get the image to the correct width or height, but not both. Whichever property you update last in the code is the one which will override. So maybe this modification will help, as it switches the order.

Sub CommandButton1_Click()


Dim strFileName As String
Dim objPic As Picture
Dim rngDest As Range

strFileName = Application.GetOpenFilename( _
    FileFilter:="Images,*.jpg;*.gif;*.png", _
    Title:="Please select an image...")

If strFileName = "False" Then Exit Sub

Set rngDest = Worksheets("Images").Range("B10:F17")
Set objPic = Worksheets("Images").Pictures.Insert(strFileName)

With objPic

  .Height = rngDest.Height
  .Width = rngDest.Width
  .Left = rngDest.Left
  .Top = rngDest.Top

End With

Set rngDest = Nothing
Set objPic = Nothing

End Sub

 

[OKCIrish]

When you say that the macro throws your image on a different page, do you mean from a print layout perspective?

I tested the macro and it was putting the image in the correct location in my "Images" sheet. But in my testing, I noticed some things that might be of use to you.

First, the ShapeRange.LockAspectRatio property never affected any pictures whether I left it in or commented it out. Sad that, because I initially felt that was going to be the key.

No the macro isn't setting the dropped picture in the correct cell that I would like it to. It's always someone where on the page and I have to click and drag it over to my print square