• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

2010 plak opties veranderen

Status
Niet open voor verdere reacties.
G

Geoffcel

Gebruiker
Lid geworden
8 jun 2009
Berichten
96
Beste lezer,

In Excel 2003 had ik een handig codetje geschreven, namelijk dat speciaal plakken niet kan en dan knippen niet functioneert en dan plakken altijd met waarde was. Nu zit ik inmiddels in 2010 en nu werkt mijn code niet meer. Weet iemand hoe ik dit weer kan bepalen. Dus knippen moet uitgeschakeld worden, speciaal plakken ook, en plakken altijd met waarde. Dit graag in het hele werkboek.

Groet :cool:,
GeoffCel
 
Lijkt me handig om de niet meer werkende code hier even te plaatsen.
 
Code: 
Private Sub Workbook_Activate()
Application.CutCopyMode = True
Application.Calculation = xlCalculationManual

Dim XLApp As Application

Set XLApp = Application

    With XLApp
        'Disable CUT
        .CommandBars("Cell").FindControl(ID:=21).Visible = False
        .CommandBars("Row").FindControl(ID:=21).Visible = False
        .CommandBars("Column").FindControl(ID:=21).Visible = False
        .CommandBars("Edit").FindControl(ID:=21).Visible = False
        
        'paste special rechtermuis findcontrol 755 uit omdat anders te aantrekkelijk
    .CommandBars("Cell").FindControl(ID:=755).Visible = False
     .CommandBars("Row").FindControl(ID:=755).Visible = False
    .CommandBars("Column").FindControl(ID:=755).Visible = False
    .CommandBars("edit").FindControl(ID:=755).Visible = False
       'paste special menu findcontrol 755 uit omdat anders te aantrekkelijk

        'paste rechtermuis findcontrol 22 verandert in 755 paste values
    .CommandBars("Cell").FindControl(ID:=22).OnAction = "PasteValues"
    .CommandBars("Row").FindControl(ID:=22).OnAction = "PasteValues"
    .CommandBars("Column").FindControl(ID:=22).OnAction = "PasteValues"
    .CommandBars("edit").FindControl(ID:=22).OnAction = "PasteValues"
    
    'Copy
    .CommandBars("Cell").FindControl(ID:=19).OnAction = "copy"
    .CommandBars("Row").FindControl(ID:=19).OnAction = "copy"
    .CommandBars("Column").FindControl(ID:=19).OnAction = "copy"
    .CommandBars("edit").FindControl(ID:=19).OnAction = "copy"

         'shortcut keys omleiden
    .OnKey "^v", "PasteValues"
    .OnKey "^+V", "PasteValues"
    .OnKey "^x", ""
    .OnKey "^+X", ""
    .OnKey "^C", "copy"
    .OnKey "^c", "copy"

          'algemene instellingen toepassen
       Application.CutCopyMode = True
       Application.CellDragAndDrop = False

End With

End Sub


    
Private Sub Workbook_Deactivate()

Application.Calculation = xlCalculationAutomatic

Dim XLApp As Application
Set XLApp = Application

   With XLApp
        'Enable CUT en Enable PASTE
              
    .CommandBars("Cell").Reset
    .CommandBars("Row").Reset
    .CommandBars("Column").Reset
    .CommandBars("Edit").Reset
    .CommandBars.FindControl(ID:=21).Reset
    .CommandBars.FindControl(ID:=22).Reset
    .CommandBars.FindControl(ID:=755).Reset

    'shortcut keys weer aanzetten
        .OnKey "^v"
        .OnKey "^+V"
        .OnKey "^x"
        .OnKey "^+X"
        .OnKey "^c"
        .OnKey "^+C"

   'evt uitgezette events altijd weer aanzetten
    Application.EnableEvents = True
 
End With

End Sub

Dit is dan de code en hij loopt vast op idcontrol 755 die heet in 2010 anders geloof ik
 
is dit wat?

Kun je hier wat mee?

[XML]Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
With Application
.CellDragAndDrop = True
.OnKey "^c"
.OnKey "^v"
.OnKey "^x"
.OnKey "+{DEL}"
.OnKey "^{INSERT}"
.CutCopyMode = False
End With
Dim Ctrl As Office.CommandBarControl
For Each Ctrl In Application.CommandBars.FindControls(ID:=19) 'copy
Ctrl.Enabled = True
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=21) ' Cut
Ctrl.Enabled = True
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=22) ' Paste
Ctrl.Enabled = True
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=755) ' Paste Special
Ctrl.Enabled = True
Next Ctrl

End Sub

Private Sub Workbook_Open()
On Error Resume Next
With Application
.CutCopyMode = False
.CellDragAndDrop = False
.OnKey "^c", ""
.OnKey "^v", ""
.OnKey "^x", ""
.OnKey "+{DEL}", ""
.OnKey "^{INSERT}", ""
End With

Dim Ctrl As Office.CommandBarControl
For Each Ctrl In Application.CommandBars.FindControls(ID:=19) ' Copy
Ctrl.Enabled = False
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=21) ' Cut
Ctrl.Enabled = False
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=22) ' Paste
Ctrl.Enabled = False
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=755) ' Paste Special
Ctrl.Enabled = False
Next Ctrl

End Sub

Private Sub Workbook_Activate()
On Error Resume Next
With Application
.CutCopyMode = False
.CellDragAndDrop = False
.OnKey "^c", ""
.OnKey "^v", ""
.OnKey "^x", ""
.OnKey "+{DEL}", ""
.OnKey "^{INSERT}", ""
End With
Dim Ctrl As Office.CommandBarControl
For Each Ctrl In Application.CommandBars.FindControls(ID:=19) ' Copy
Ctrl.Enabled = False
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=21) ' Cut
Ctrl.Enabled = False
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=22) ' Paste
Ctrl.Enabled = False
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=755) ' Paste Special
Ctrl.Enabled = False
Next Ctrl

End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Cancel = True
MsgBox "Right click menu deactivated." & vbCrLf & _
"For this file:", 16, ""
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.CutCopyMode = False
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)

On Error Resume Next
With Application
.CutCopyMode = False
.CellDragAndDrop = False
.OnKey "^c", ""
.OnKey "^v", ""
.OnKey "^x", ""
.OnKey "+{DEL}", ""
.OnKey "^{INSERT}", ""
End With
Dim Ctrl As Office.CommandBarControl
For Each Ctrl In Application.CommandBars.FindControls(ID:=19) ' Copy
Ctrl.Enabled = False
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=21) ' Cut
Ctrl.Enabled = False
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=22) ' Paste
Ctrl.Enabled = False
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=755) ' Paste Special
Ctrl.Enabled = False
Next Ctrl

End Sub
Private Sub Workbook_Deactivate()
On Error Resume Next
With Application
.CellDragAndDrop = True
.OnKey "^c"
.OnKey "^v"
.OnKey "^x"
.OnKey "+{DEL}"
.OnKey "^{INSERT}"
.CutCopyMode = False
End With
Dim Ctrl As Office.CommandBarControl
For Each Ctrl In Application.CommandBars.FindControls(ID:=19) ' Copy
Ctrl.Enabled = True
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=21) ' Cut
Ctrl.Enabled = True
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=22) ' Paste
Ctrl.Enabled = True
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=755) ' Paste Special
Ctrl.Enabled = True
Next Ctrl

End Sub

[/XML]
 
Hier kan ik volgens mij wel wat mee.
Heel erg bedankt voor het juiste zetje in de goede richting :thumb:
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan