Code to disable "paste" as an option

  • Thread starter Thread starter Jonsson
  • Start date Start date
J

Jonsson

Hi,

I have got this code from the forum, and it works great, but can anyon
help me to modify it a little bit?

I want it to disable "paste" so that the only option that is possibl
should be "paste special", "values".


Any help is appreciated!

Thomas

Sub Nocut()

Dim oCtls As CommandBarControls, oCtl As CommandBarControl
Set oCtls = CommandBars.FindControls(ID:=21) ''Cut
If Not oCtls Is Nothing Then
For Each oCtl In oCtls
oCtl.Enabled = False
Next
End If
Set oCtls = CommandBars.FindControls(ID:=522) ''Options
If Not oCtls Is Nothing Then
For Each oCtl In oCtls
oCtl.Enabled = False
Next
End If
With Application
.OnKey "^x", ""
.OnKey "+{Del}", ""
.CellDragAndDrop = False

End With

End Su
 
You can disable the paste and paste special button and add
The paste special values button to the standard toolbar or so

Sub Add_Paste_special_button()
Application.CommandBars("standard").Controls. _
Add Type:=msoControlButton, ID:=370, before:=10
End Sub

Maybe this page will help you
http://www.rondebruin.com/menuid.htm
 
The problem is that a user can paste by just pressing Enter after a Copy.
So you have to disable Enter too.

I haven't tried this is real life so I don't know of any bad side effects.
It doesn't affect normal data entry because macros do not run when Excel is
in Edit or Entry modes.

Application.OnKey "{Enter}", ""
Application.OnKey "~", ""

--
Jim Rech
Excel MVP
| Hi,
|
| I have got this code from the forum, and it works great, but can anyone
| help me to modify it a little bit?
|
| I want it to disable "paste" so that the only option that is possible
| should be "paste special", "values".
|
|
| Any help is appreciated!
|
| Thomas
|
| Sub Nocut()
|
| Dim oCtls As CommandBarControls, oCtl As CommandBarControl
| Set oCtls = CommandBars.FindControls(ID:=21) ''Cut
| If Not oCtls Is Nothing Then
| For Each oCtl In oCtls
| oCtl.Enabled = False
| Next
| End If
| Set oCtls = CommandBars.FindControls(ID:=522) ''Options
| If Not oCtls Is Nothing Then
| For Each oCtl In oCtls
| oCtl.Enabled = False
| Next
| End If
| With Application
| OnKey "^x", ""
| OnKey "+{Del}", ""
| CellDragAndDrop = False
|
| End With
|
| End Sub
|
|
| ---
| Message posted
|
 
Hi Ron!

You really helped me by sending me the links to your page. Thanks!!
Now I've fixed the code so that "paste" also is enabled.

I also had a look at your reference links (MS), and learned some more
but....
Is it impossible to get ID's to "paste Special", Formulas, Values, an
Format?
If possible I could set "disable" to all options but enabled to Values
right?

This would help me a lot, because my users destroy some cells whe
choosing "paste all".

Thanks in advance!

//Thoma
 
Hi Jonsson
You really helped me by sending me the links to your page
Click to expand...
I will add more stuff soon

It is easier to disable all toolbars and create your own bar with
the options you want.

Don't forget to disable the shortcuts and be sure that your restore
it back in the old situation.
 
Hi Ron!

I totally agree, but I have already disabled all menubars and I want i
to stay that way. The problem (for me) occurs when users right-clic
and choose "paste special" and have acces to the options "paste all"
"format", "formulas" and some other option in the right-click menu.
I'm looking for a codeline that "point-out" "values" as the only optio
to choose in the right-click menu-bar.
I think, if I could get the ID's for these options from you, I'll ge
along fine, thanks to you!!!

Thanks in advance (again)!!

//Thoma
 
OK

Maybe you like this

Sub Test_Cell_Menu()
Dim Ctl As CommandBarControl
For Each Ctl In CommandBars("Cell").Controls
Ctl.Enabled = False
Next Ctl
Application.CommandBars("cell").Controls. _
Add Type:=msoControlButton, ID:=370, before:=1
End Sub

Sub Reset_Cell_menu()
Application.CommandBars("cell").Reset
End Sub
 
Hi Ron!

You have solved my problem!!
Thanks for your help with this!!

This is how the code turned out:

With ActiveWindow
Application.CommandBars(1).Enabled = False 'True to restore

.DisplayHeadings = False
.DisplayWorkbookTabs = False
End With
Application.CommandBars("Standard").Visible = False
Application.CommandBars("Formatting").Visible = False
Application.CommandBars("Drawing").Visible = False
Application.CommandBars("Visual Basic").Visible = False

For Each Ctl In CommandBars("Cell").Controls
Ctl.Enabled = False
Next Ctl
Application.CommandBars("cell").Controls. _
Add Type:=msoControlButton, ID:=370, before:=1
Set oCtls = CommandBars.FindControls(ID:=19) ''Copy
If Not oCtls Is Nothing Then
For Each oCtl In oCtls
oCtl.Enabled = True
Next
End If
With Application
.OnKey "^v", ""
.OnKey "^x", ""
.OnKey "+{Del}", ""
.CellDragAndDrop = False

End With
End Function
Function Auto_Close()

With ActiveWindow
Application.CommandBars(1).Enabled = True 'True to restore

.DisplayHeadings = False

End With
Application.CommandBars("Standard").Visible = True
Application.CommandBars("Formatting").Visible = True
Application.CommandBars("Drawing").Visible = True

Application.CommandBars("cell").Reset
With Application
.OnKey "^v"
.OnKey "^x"
.OnKey "+{Del}"
.CellDragAndDrop = True
End With

Application.Quit
End Function


//Thoma
 
Back
Top