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