Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
AutoShape Copy and Paste
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. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
AutoShape Copy and Paste
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. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
AutoShape Copy and Paste
It wouldn't operate on both sheets simultaneously. You would do one sheet,
then activate the next sheet and do it with the same code. If you don't want to see it, Application.ScreenUpdating = False ' code that activates and operates on another sheet Application.ScreenUpdating = True or you could write the macro to work on another sheet by qualifying your references. If your pasting to the activecell, however, that won't work. -- Regards, Tom Ogilvy "Phil H" wrote in message ... 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. |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
AutoShape Copy and Paste
Tom, can we skin this cat another way - insert an "Update" button control on
Sheet1 with code saying: delete the graphics in cells A11, B22, C33, whatever cell, etc; and paste the graphics in Sheet3/cellP3 to Sheet1/cellT6, Sheet3/cellg19 to Sheet1/cell U5, etc.? Another question - file size is growing alarmingly! I read that making each graphic a metafile mitigates against this growth. I converted one of the graphics to a metafile, and set it up to paste. The paste worked, but it did not delete the previous graphic. Can we work these two issues through? "Tom Ogilvy" wrote: It wouldn't operate on both sheets simultaneously. You would do one sheet, then activate the next sheet and do it with the same code. If you don't want to see it, Application.ScreenUpdating = False ' code that activates and operates on another sheet Application.ScreenUpdating = True or you could write the macro to work on another sheet by qualifying your references. If your pasting to the activecell, however, that won't work. -- Regards, Tom Ogilvy "Phil H" wrote in message ... 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. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Can't Copy and Paste or Paste Special between Excel Workbooks | Excel Discussion (Misc queries) | |||
Copy; Paste; Paste Special are disabled | Excel Discussion (Misc queries) | |||
help w/ generic copy & paste/paste special routine | Excel Programming | |||
Excel cut/Paste Problem: Year changes after data is copy and paste | Excel Discussion (Misc queries) | |||
Copy and Paste macro needs to paste to a changing cell reference | Excel Programming |