Select Shape in activerow

[Thomp]

I need to select the shape in the active row or active cell and delete
that shape before pasting a new shape in the active cell. Sometimes
the cell will have a shape in it and will need to be replaced and
other times the cell will be empty and will be just a copy and paste
of the autoshape into the active cell. I don't think I can go with the
shapes name as that will change each time I paste the new shape in the
active cell. Here is the code I have so far that copys and paste into
empty active cell.


ActiveCell.Select
Selection.ClearContents
ActiveSheet.Shapes("AutoShape 7").Select
Selection.Copy
ActiveCell.Select
ActiveSheet.Paste

Also is there a way to center the shape in the active cell

thanks

 

[Guest]

This code should select all the shapes on a worksheet. Use the .left and
..right to center. When Pating a shape you can't paste it at a location. You
can only paste it on a sheet using the chartwizard. You then have to select
the chart and move iot using .left, .right, ..top, .bottom.

For Each AllCharts In Worksheets(TemperatureSheetName).Shapes

ChartName = "Temp Chart" + Str(SerialNumber)

If InStr(AllCharts.Name, "Temp Chart") = 0 Then
AllCharts.Name = ChartName

Worksheets(TemperatureSheetName).ChartObjects(ChartName).Activate
ActiveChart.Axes(xlValue).Select
With ActiveChart.Axes(xlValue)
.MinimumScale = 90
.MaximumScale = 160
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With

Worksheets(TemperatureSheetName).Shapes(ChartName).Top = _
Worksheets(TemperatureSheetName). _
Rows((ChartRowOffset * (ModChartNumber)) + 1).Top
Worksheets(TemperatureSheetName).Shapes(ChartName).Left = _
Worksheets(TemperatureSheetName).Columns(MyColumnOffset).Left
End If

Next AllCharts

 

[Guest]

Public Function FindShape(rng as Range) as Shape
Dim shp as Shape, rng1 as Range, rng2 as Range

for each shp in rng.parent.Shapes
set rng1 = shp.TopLeftCell
set rng2 = shp.BottomRightCell
if rng.Row >= rng1.row and rng.row <= rng2.row then
set Findshape = shp
exit for
end if
Next
set FindShape = Nothing
End Function

Usage

Sub ABC()
Dim shp as Shape
set shp = FindShape(ActiveCell)
if not shp is nothing then
shp.Delete
end if
End Sub

Look at other sample code and some cautions at this page
http://www.rondebruin.nl/controlsobjectsworksheet.htm