Hi Tom,

Thanks for your reply. I'm now trying to capture the original top and left
values through variables and then using these values to help calculate the
new top and left values I would like after the resizing. The problem is that
I can't get the code right to capture the original top and left values -- I
get the "Run-time error 438 -- Object doesn't support this property or method
" error when I execute the following code --any help is appreciated!

Sub resizing()

Dim sourcevar
Dim currenttop
Dim currentleft

Sheets("1st Level Graph").Select

'Sources and Conveyer
ActiveSheet.Shapes("AutoShape 18").Select

'Below is where I am getting the error
currenttop = ActiveSheet.Selection.ShapeRange.Top.Value
currentleft = ActiveSheet.Selection.ShapeRange.Left.Value


sourcevar = Range("C9").Value - 0.167 + 1

If sourcevar < 1.5 Then
Selection.ShapeRange.Height = 83.57763975 * sourcevar
Selection.ShapeRange.Width = 99.1875 * sourcevar
Selection.ShapeRange.Top = currenttop + ((83.57763975 * sourcevar) -
83.57763975)
Selection.ShapeRange.Left = currentleft + ((99.1875 * sourcevar) -
99.1875)
Else

Selection.ShapeRange.Height = 83.57763975 * 1.5
Selection.ShapeRange.Width = 99.1875 * 1.5
Selection.ShapeRange.Top = currenttop + ((83.57763975 * 1.5) -
83.57763975)
Selection.ShapeRange.Left = currentleft + ((99.1875 * 1.5) - 99.1875)

End If

"Tom Ogilvy" wrote:

the shape has
Top
Left
Height
Width

properties. You will have to calculate the adjustments you need to Top and
Left based on the changes you made to Height and Width

--
Regards,
Tom Ogilvy

"Linking to specific cells in pivot table"
crosoft.com wrote in
message ...
Hi,

I have a macro set up to re-size a Shape (or Autoshape -- it's a
trapezoid)
based on values input into a cell on the spreadsheet. The problem is that
it
looks like the macro is simply extending one side of the Shape rather than
all sides of the shape equally, resulting in the object no longer being
centered over the same point in the spreadsheet it was originally centered
over. I need to find a way to have the Shape remain centered over the
same
point in the spreadsheet after being re-sized.

Below is the code I have for the re-sizing -- any help is greatly
appreciated!

ActiveSheet.Shapes("AutoShape 18").Select

sourcevar = Range("C9").Value - 0.167 + 1

If sourcevar < 1.5 Then
Selection.ShapeRange.Height = 83.57763975 * sourcevar
Selection.ShapeRange.Width = 99.1875 * sourcevar
Else

Selection.ShapeRange.Height = 83.57763975 * 1.5
Selection.ShapeRange.Width = 99.1875 * 1.5
End If