View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Phil H[_2_] Phil H[_2_] is offline
external usenet poster
 
Posts: 87
Default AutoShape Copy and Paste

Hi Tom,

This works exactly as needed on Sheet3. I cleared two "variable not
defined" errors by adding dim statements for shp and rng.

Sub PasteRedSteady()
Dim shpTemp As Shape
Dim shp As Shape
Dim rng As Range
Set shpTemp = ActiveWorkbook.Worksheets("Graphics").Shapes("RedS teadyPaste")
For Each shp In ActiveSheet.Shapes
Set rng = Range(shp.TopLeftCell, shp.BottomRightCell)
If Not Intersect(rng, ActiveCell) Is Nothing Then
shp.Delete
End If
Next
PasteCenterOfRange shpTemp
Set shpTemp = Nothing
End Sub

As follow-on, I'm trying to grasp code statements better. I didn't
understand the comment about having the code "repeat" on Sheet1. How would
this be done? When the code operates, it operates on the active worksheet,
whatever it is - correct? How would it work simultaneously on a linked cell
in an inactive worksheet?

I have these paste-graphics macros located in Module2 because when I finish
this model, there will be about 10 worksheets that need to operate like we
are setting up Sheet3 in this example. All the "Sheet3s" will have cells
linked to Sheet1, and Sheet1 will hold the link formula. In other words as
the ten Sheet3s are updated, that update rolls up to Sheet1 (which will be
named: "Financial Dashboard")

"Tom Ogilvy" wrote:

Sub PasteRedSteady()
Dim shpTemp As Shape
Set shpTemp =
ActiveWorkbook.Worksheets("Graphics").Shapes("RedS teadyPaste")
for each shp in Activesheet.Shapes
set rng = Range(shp.topLeftCell,shp.bottomRightCell)
if not intersect(rng,activecell) is nothing then
shp.Delete
end if
Next
PasteCenterOfRange shpTemp
Set shpTemp = Nothing
End Sub

Just have your code repeat any actions on the second sheet.

--
Regards,
Tom Ogilvy



"Phil H" wrote:

Using Excel 2003, this code was provided to me.

On sheet 3, an oval autoshape (one of many on the worksheet) has the below
code (macro) assigned to it.

Sub PasteRedSteady()
Dim shpTemp As Shape
Set shpTemp =
ActiveWorkbook.Worksheets("Graphics").Shapes("RedS teadyPaste")
PasteCenterOfRange shpTemp
Set shpTemp = Nothing
End Sub

The pasted oval autoshape is held in a worksheet named Graphics. The
example autoshape name is RedSteadyPaste. There are others with other names
too €“ each different autoshape having its own paste macro. Macros are
located in Module2.

When a user selects a cell or merged cell range, and clicks on an oval
autoshape(located on that same worksheet) with the macro assigned to it, a
duplicate oval autoshape, without code assigned to it, is pasted into the
center of the selected cell/cell range.

Sub PasteCenterOfRange(UseShape As Shape)
UseShape.Copy
ActiveSheet.Paste
With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
.Left = ActiveCell.MergeArea.Left + ((ActiveCell.MergeArea.Width -
.Width) / 2)
.Top = ActiveCell.MergeArea.Top + ((ActiveCell.MergeArea.Height -
.Height) / 2)
End With
ActiveCell.Select
End Sub

1.) To delete the pasted autoshape, it is highlighted and deleted. The
problem is deletion. If the user selects a cell with an autoshape already in
it and does not delete the existing autoshape, a new autoshape can be pasted
over it, thus, many autoshapes can be €śstacked€ť in a cell. Is there a way to
delete the current autoshape(s), or clear the cell of any graphics, before
pasting a new one? This problem is graphics are bloating file size.

2.) Another question too. Is there a way to have all these above actions
duplicated in a linked cell/range on another worksheet? Whatever happens in
the Sheet3 cell/range happens exactly the same way in a Sheet1 cell/range.
Sheet3 is the source, Sheet1 is the target.

Any help would be greatly appreciated. Thanks, Phil.