Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Removing Macro from a shape as it is pasted
Hello.
I have a macro which is used in a sheet used to draw diagrams. The user clicks on the shape which is then copied, enlarged and pasted a few cells to the right. The problem I am having is that the macro is still assigned to the pasted shape, so when a user clicks on this shape, to move or resize it, the macro runs again. So they end up with shapes all over the place. Can anyone tell me how to remove the macro from the pasted shape? Here is the macro... Sub Macro1() ActiveSheet.Unprotect Dim shp As Shape Dim name As String 'Change Rectangle 22 to actual name of shape name = ActiveSheet.Shapes(Application.Caller).name On Error GoTo Badentry 'Selects the shape using the name of the active shape Set shp = ActiveSheet.Shapes(name) shp.Select 'Change Range to wherever keeping counter Selection.Copy 'Change Range to wherever pasting shape ActiveCell.Offset(0, 4).Select ActiveSheet.Paste Selection.ShapeRange.ScaleWidth 2.5, msoFalse, msoScaleFromTopLeft Selection.ShapeRange.ScaleHeight 2.5, msoFalse, msoScaleFromTopLeft ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True Exit Sub Badentry: msg = "An error has occurred." msg = msg + vbNewLine + vbNewLine msg = msg + "Click on the name of an item in the menu, and then on the grey key." msg = msg + vbNewLine + vbNewLine msg = msg + "If you still get an error, e-mail P&D Technical Support Team" Ans = MsgBox(msg, vbExclamation, "Menu Problem") ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Removing Macro from a shape as it is pasted
The following modifications seems to work. You can also remove a macro from a shape by changing its OnAction property to a vbNullString. It is not a good idea to use "name" as a variable... -- Jim Cone San Francisco, USA http://www.realezsites.com/bus/primitivesoftware (color sort, compare, unique, thesaurus and other add-ins) Sub Macro_R1() On Error GoTo Badentry ActiveSheet.Unprotect Dim shp As Shape Dim sName As String Dim msg As String Dim ans As Long sName = ActiveSheet.Shapes(Application.Caller).Name Set shp = ActiveSheet.Shapes(sName) shp.Copy shp.TopLeftCell.Offset(0, 4).PasteSpecial 'Selection.ShapeRange.ScaleWidth 2.5, msoFalse, msoScaleFromTopLeft 'Selection.ShapeRange.ScaleHeight 2.5, msoFalse, msoScaleFromTopLeft ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True Exit Sub Badentry: msg = "An error has occurred." msg = msg + vbNewLine + vbNewLine msg = msg + "Click on the name of an item in the menu, and then on the grey key." msg = msg + vbNewLine + vbNewLine msg = msg + "If you still get an error, e-mail P&D Technical Support Team" ans = MsgBox(msg, vbExclamation, "Menu Problem") ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True End Sub '------------ "Igby" wrote in message Hello. I have a macro which is used in a sheet used to draw diagrams. The user clicks on the shape which is then copied, enlarged and pasted a few cells to the right. The problem I am having is that the macro is still assigned to the pasted shape, so when a user clicks on this shape, to move or resize it, the macro runs again. So they end up with shapes all over the place. Can anyone tell me how to remove the macro from the pasted shape? Here is the macro... Sub Macro1() ActiveSheet.Unprotect Dim shp As Shape Dim name As String 'Change Rectangle 22 to actual name of shape name = ActiveSheet.Shapes(Application.Caller).name On Error GoTo Badentry 'Selects the shape using the name of the active shape Set shp = ActiveSheet.Shapes(name) shp.Select 'Change Range to wherever keeping counter Selection.Copy 'Change Range to wherever pasting shape ActiveCell.Offset(0, 4).Select ActiveSheet.Paste Selection.ShapeRange.ScaleWidth 2.5, msoFalse, msoScaleFromTopLeft Selection.ShapeRange.ScaleHeight 2.5, msoFalse, msoScaleFromTopLeft ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True Exit Sub Badentry: msg = "An error has occurred." msg = msg + vbNewLine + vbNewLine msg = msg + "Click on the name of an item in the menu, and then on the grey key." msg = msg + vbNewLine + vbNewLine msg = msg + "If you still get an error, e-mail P&D Technical Support Team" Ans = MsgBox(msg, vbExclamation, "Menu Problem") ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Removing Macro from a shape as it is pasted
That is great - thank you.
As an aside if I put the scaling back in it magnifies the fill design of the shape, rather than just increasing the diamensions fo the shape. It isn't a problem but I wondered how/why it works. Thanks again "Jim Cone" wrote: The following modifications seems to work. You can also remove a macro from a shape by changing its OnAction property to a vbNullString. It is not a good idea to use "name" as a variable... -- Jim Cone San Francisco, USA http://www.realezsites.com/bus/primitivesoftware (color sort, compare, unique, thesaurus and other add-ins) Sub Macro_R1() On Error GoTo Badentry ActiveSheet.Unprotect Dim shp As Shape Dim sName As String Dim msg As String Dim ans As Long sName = ActiveSheet.Shapes(Application.Caller).Name Set shp = ActiveSheet.Shapes(sName) shp.Copy shp.TopLeftCell.Offset(0, 4).PasteSpecial 'Selection.ShapeRange.ScaleWidth 2.5, msoFalse, msoScaleFromTopLeft 'Selection.ShapeRange.ScaleHeight 2.5, msoFalse, msoScaleFromTopLeft ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True Exit Sub Badentry: msg = "An error has occurred." msg = msg + vbNewLine + vbNewLine msg = msg + "Click on the name of an item in the menu, and then on the grey key." msg = msg + vbNewLine + vbNewLine msg = msg + "If you still get an error, e-mail P&D Technical Support Team" ans = MsgBox(msg, vbExclamation, "Menu Problem") ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True End Sub '------------ "Igby" wrote in message Hello. I have a macro which is used in a sheet used to draw diagrams. The user clicks on the shape which is then copied, enlarged and pasted a few cells to the right. The problem I am having is that the macro is still assigned to the pasted shape, so when a user clicks on this shape, to move or resize it, the macro runs again. So they end up with shapes all over the place. Can anyone tell me how to remove the macro from the pasted shape? Here is the macro... Sub Macro1() ActiveSheet.Unprotect Dim shp As Shape Dim name As String 'Change Rectangle 22 to actual name of shape name = ActiveSheet.Shapes(Application.Caller).name On Error GoTo Badentry 'Selects the shape using the name of the active shape Set shp = ActiveSheet.Shapes(name) shp.Select 'Change Range to wherever keeping counter Selection.Copy 'Change Range to wherever pasting shape ActiveCell.Offset(0, 4).Select ActiveSheet.Paste Selection.ShapeRange.ScaleWidth 2.5, msoFalse, msoScaleFromTopLeft Selection.ShapeRange.ScaleHeight 2.5, msoFalse, msoScaleFromTopLeft ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True Exit Sub Badentry: msg = "An error has occurred." msg = msg + vbNewLine + vbNewLine msg = msg + "Click on the name of an item in the menu, and then on the grey key." msg = msg + vbNewLine + vbNewLine msg = msg + "If you still get an error, e-mail P&D Technical Support Team" Ans = MsgBox(msg, vbExclamation, "Menu Problem") ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Macro code to center pasted data in a column | Excel Discussion (Misc queries) | |||
Getting macro to run with pasted function | New Users to Excel | |||
my curser changed from arrow shape to a cross shape???? | New Users to Excel | |||
Creating a macro where values are copied and pasted into a sheet | Excel Programming | |||
Unassigning / Removing Macro from Shape | Excel Programming |