Z
ZipCurs
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
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