You don't need shape range

Sub InsertPicture()

Dim myPicture As String

myPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif),*.gif; *.jpg; *.bmp; *.tif", ,
"Select Picture to Import")
If myPicture < "" Then
ActiveSheet.Pictures.Insert (myPicture)
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Selec t

With Selection

..ShapeRange.LockAspectRatio = msoFalse
..Height = ActiveCell.RowHeight
..Width = ActiveCell.ColumnWidth * 5.25 + 4
..Top = ActiveCell.Top
..Left = ActiveCell.Right
..Placement = xlMoveAndSize


End With
End If
End Sub


"Secret Squirrel" wrote:

I added that to my code but now I'm getting an error, "Object doesn't support
this property or method".
Here's what the code looks like with your added code.

Sub InsertPicture()

Dim myPicture As String

myPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif),*.gif; *.jpg; *.bmp; *.tif", ,
"Select Picture to Import")
If myPicture < "" Then
ActiveSheet.Pictures.Insert (myPicture)
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Selec t

With Selection

.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = ActiveCell.RowHeight
.ShapeRange.Width = ActiveCell.ColumnWidth * 5.25 + 4
.ShapeRange.Top = ActiveCell.Top
.ShapeRange.Left = ActiveCell.Right
.Placement = xlMoveAndSize


End With
End If
End Sub

"Joel" wrote:

Picture are shapes which sit on top of a cell and not in the cell. To allign
a picture to a cell you have to use pixels. Both shapes and cells have the
location of their top left corner in pixels as parameter called .LEFT and
.RIGHT. If you want the picture to move to a cell then use the following:

ShapeRange.Top = activecell.Top
ShapeRange.Left = activecell.Right

Ther is a small border around each cell. The picture may be slightly off
center of the cell because of the border. That is why I posted my last code,
I didn't rrealize the picture wasn't located where you wanted to put it. One
caution, if you rezie the column width or row height the picture will not
move and will not be centered on the same cell.


"Secret Squirrel" wrote:

Not sure I follow you. Right now when I run this macro it does what I want
and inserts the picture and sizes it to the height/width of the selected cell
but it doesn't put the picture in that cell. I have drag it to the cell. I
would much rather have the code put it in the cell automatically.

"Joel" wrote:

You have to add to the .left and .top properties. I assume you mean height
because the width is 5 times the cell width.

I would find the top of the cell below and then center the picture between
the two numbers

Y1 = activecell.top
Y2 = activecell.offset(1,0).top
H1 = activecell.height
Border = (Y2 - Y1) - H1
NewTop = Y1 + (Border/2)
ShapeRange.Top = NewTop

"Secret Squirrel" wrote:

I'm using this code to insert a picture and resize it to the currently
selected cell. The problem is that the picture resizes but doesn't center in
the selected cell. How can I add this to my code so that picture will center
to the selected cell?

Sub InsertPicture()

Dim myPicture As String

myPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif),*.gif; *.jpg; *.bmp; *.tif", ,
"Select Picture to Import")
If myPicture < "" Then
ActiveSheet.Pictures.Insert (myPicture)
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Selec t

With Selection

.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = ActiveCell.RowHeight
.ShapeRange.Width = ActiveCell.ColumnWidth * 5.25 + 4
.Placement = xlMoveAndSize


End With
End If
End Sub