Move a picture with a vba macro
 

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

Move a picture with a vba macro
 

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

Move a picture with a vba macro
 

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

Move a picture with a vba macro
 

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

Move a picture with a vba macro
 

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

Move a picture with a vba macro
 

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

Move a picture with a vba macro
 

Still getting that same error message. But after I click OK on the error it
places the picture in another cell.

"Joel" wrote:

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

Move a picture with a vba macro
 

There is no such thing as right, should of been left

from
..Left = ActiveCell.right
to
..Left = ActiveCell.Left

"Secret Squirrel" wrote:

Still getting that same error message. But after I click OK on the error it
places the picture in another cell.

"Joel" wrote:

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

Move a picture with a vba macro
 

Works perfectly! Thanks for your help!

"Joel" wrote:

There is no such thing as right, should of been left

from
.Left = ActiveCell.right
to
.Left = ActiveCell.Left

"Secret Squirrel" wrote:

Still getting that same error message. But after I click OK on the error it
places the picture in another cell.

"Joel" wrote:

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

Move a picture with a vba macro
 

Make it run a little more smoothly by not selecting the pictu

Sub InsertPicture()

Dim myPicture As String

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

.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

Also I think this will not work uniformly if you change font, font size, and
font style (bold, italic):

.Width = ActiveCell.ColumnWidth * 5.25 + 4

Instead try this:

.Width = ActiveCell.Width

You can also just use .Height instead of .RowHeight.

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Tutorials and Custom Solutions
Peltier Technical Services, Inc. - http://PeltierTech.com
_______


"Secret Squirrel" wrote in
message ...
Works perfectly! Thanks for your help!

"Joel" wrote:

There is no such thing as right, should of been left

from
.Left = ActiveCell.right
to
.Left = ActiveCell.Left

"Secret Squirrel" wrote:

Still getting that same error message. But after I click OK on the
error it
places the picture in another cell.

"Joel" wrote:

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