| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Centering a Shape over a given cell when resizing
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 |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Centering a Shape over a given cell when resizing
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 |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Centering a Shape over a given cell when resizing
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 |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Centering a Shape over a given cell when resizing
currenttop = ActiveSheet.Selection.ShapeRange.Top
currentleft = ActiveSheet.Selection.ShapeRange.Left No value on the end. Demo from the immediate window: the selection was a trapezoid from the Autoshapes: ? typename(selection) Rectangle ? selection.Name AutoShape 1 ? selection.ShapeRange.top 189.75 ? selection.ShapeRange.Left 362.25 ? selection.top 189.75 ? selection.Left 362.25 -- Regards, Tom Ogilvy "Linking to specific cells in pivot table" crosoft.com wrote in message ... 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 |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Centering a Shape over a given cell when resizing
Is this what you want??
ActiveSheet.Shapes("AutoShape 18").Select sourceVar = Range("A1").Value - 0.167 + 1 prevCenterH = Selection.ShapeRange.Left + (Selection.ShapeRange.Width / 2) prevCenterV = Selection.ShapeRange.Top + (Selection.ShapeRange.Height / 2) 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 Selection.ShapeRange.Left = prevCenterH - (Selection.ShapeRange.Width / 2) Selection.ShapeRange.Top = prevCenterV - (Selection.ShapeRange.Height / 2) Regards, Jayant |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Centering a Shape over a given cell when resizing
Thanks Tom!
"Tom Ogilvy" wrote: currenttop = ActiveSheet.Selection.ShapeRange.Top currentleft = ActiveSheet.Selection.ShapeRange.Left No value on the end. Demo from the immediate window: the selection was a trapezoid from the Autoshapes: ? typename(selection) Rectangle ? selection.Name AutoShape 1 ? selection.ShapeRange.top 189.75 ? selection.ShapeRange.Left 362.25 ? selection.top 189.75 ? selection.Left 362.25 -- Regards, Tom Ogilvy "Linking to specific cells in pivot table" crosoft.com wrote in message ... 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 |
|
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Centering a Shape over a given cell when resizing
This is great! Thanks!
"jjk" wrote: Is this what you want?? ActiveSheet.Shapes("AutoShape 18").Select sourceVar = Range("A1").Value - 0.167 + 1 prevCenterH = Selection.ShapeRange.Left + (Selection.ShapeRange.Width / 2) prevCenterV = Selection.ShapeRange.Top + (Selection.ShapeRange.Height / 2) 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 Selection.ShapeRange.Left = prevCenterH - (Selection.ShapeRange.Width / 2) Selection.ShapeRange.Top = prevCenterV - (Selection.ShapeRange.Height / 2) Regards, Jayant |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Cell Text Alignment - Not A Centering Issue | Excel Discussion (Misc queries) | |||
| my curser changed from arrow shape to a cross shape???? | New Users to Excel | |||
| Resizing cells in a selection without resizing entire sheet | Excel Discussion (Misc queries) | |||
| Deleting a shape and the cell contents the shape is in. | Excel Programming | |||
| Deleting a shape and the cell contents the shape is in. | Excel Programming | |||
Linear Mode
