Centering picture in Excel 2007
 

I have some code that sizes and centers an image in a target cell. This
works great in Excel 2000 and 2003. Unfortunately, it only does 75% of the
job in Excel 2007. The scaling and horizontal position are good, but the
vertical position is slightly off. Is there some difference in 2007 that I
need to compensate for?

Thank you in advance. The code is listed below:

'Scale correctly
HeightRatio = ActiveSheet.Shapes(ActivePicture).Height / Cells(TargetLine,
6).Height
WidthRatio = ActiveSheet.Shapes(ActivePicture).Width / Cells(TargetLine,
6).Width

If HeightRatio = WidthRatio Then
ActiveSheet.Shapes(ActivePicture).Select
Selection.ShapeRange.Height = 0.95 *
ActiveSheet.Shapes(ActivePicture).Height / HeightRatio
Else
ActiveSheet.Shapes(ActivePicture).Select
Selection.ShapeRange.Width = 0.95 *
ActiveSheet.Shapes(ActivePicture).Width / WidthRatio
End If

'Position picture correctly
With ActiveSheet.Shapes(ActivePicture)
.Top = Cells(TargetLine, 6).Top + (Cells(TargetLine, 6).Height -
..Height) / 2
.Left = Cells(TargetLine, 6).Left + (Cells(TargetLine, 6).Width -
..Width) / 2
End With

Centering picture in Excel 2007
 

Further investigation shows that final position does indeed have the
calculated value even though the visual position of the image is wrong. In
atleast one case the top of the imported image is above the cell border, even
though the .Top value is greater. Note that I am importing JPEG images of
scanned sketches, although I can't imaging how that would make any
difference.

"ZipCurs" wrote:

I have some code that sizes and centers an image in a target cell. This
works great in Excel 2000 and 2003. Unfortunately, it only does 75% of the
job in Excel 2007. The scaling and horizontal position are good, but the
vertical position is slightly off. Is there some difference in 2007 that I
need to compensate for?

Thank you in advance. The code is listed below:

'Scale correctly
HeightRatio = ActiveSheet.Shapes(ActivePicture).Height / Cells(TargetLine,
6).Height
WidthRatio = ActiveSheet.Shapes(ActivePicture).Width / Cells(TargetLine,
6).Width

If HeightRatio = WidthRatio Then
ActiveSheet.Shapes(ActivePicture).Select
Selection.ShapeRange.Height = 0.95 *
ActiveSheet.Shapes(ActivePicture).Height / HeightRatio
Else
ActiveSheet.Shapes(ActivePicture).Select
Selection.ShapeRange.Width = 0.95 *
ActiveSheet.Shapes(ActivePicture).Width / WidthRatio
End If

'Position picture correctly
With ActiveSheet.Shapes(ActivePicture)
.Top = Cells(TargetLine, 6).Top + (Cells(TargetLine, 6).Height -
.Height) / 2
.Left = Cells(TargetLine, 6).Left + (Cells(TargetLine, 6).Width -
.Width) / 2
End With