• 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.

Beveiligen Excel werkblad

Status
Niet open voor verdere reacties.

MichaelvandenBerg

Gebruiker
Lid geworden
25 jan 2020
Berichten
12
Beste leden,

Ik heb een excel werkmap waarin ongeblokkeerde cellen zijn beveiligd tegen kopieren/knippen en plakken om de layout te beschermen.

Als ik rechtermuisknop klik is alles geblokkeerd.
KOPIEREN PLAKKEN.jpg

Als ik shortcuts gebruik zoals CTRL+C en CTRL+V dan werkt kopieren/knippen en plakken ook niet en verschijnt er een melding.
KOPIEREN PLAKKEN 1.jpg

Nu het probleem.
Als ik in de werkbalk kopieren/knippen en plakken kies dan werkt het daar nog wel. Hoe kan ik ze daar ook blokkeren?
KOPIEREN PLAKKEN 2.jpg

Ik heb nu onderstaande code in VBA staan. Met behulp van google gevonden toen ook.

'*** In a standard module ***
Option Explicit

Sub ToggleCutCopyAndPaste(Allow As Boolean)
'Activate/deactivate cut, copy, paste and pastespecial menu items
Call EnableMenuItem(21, Allow) ' cut
Call EnableMenuItem(19, Allow) ' copy
Call EnableMenuItem(22, Allow) ' paste
Call EnableMenuItem(755, Allow) ' pastespecial

'Activate/deactivate drag and drop ability
Application.CellDragAndDrop = Allow

'Activate/deactivate cut, copy, paste and pastespecial shortcut keys
With Application
Select Case Allow
Case Is = False
.OnKey "^c", "CutCopyPasteDisabled"
.OnKey "^v", "CutCopyPasteDisabled"
.OnKey "^x", "CutCopyPasteDisabled"
.OnKey "+{DEL}", "CutCopyPasteDisabled"
.OnKey "^{INSERT}", "CutCopyPasteDisabled"
Case Is = True
.OnKey "^c"
.OnKey "^v"
.OnKey "^x"
.OnKey "+{DEL}"
.OnKey "^{INSERT}"
End Select
End With
End Sub

Sub EnableMenuItem(ctlId As Integer, Enabled As Boolean)
'Activate/Deactivate specific menu item
Dim cBar As CommandBar
Dim cBarCtrl As CommandBarControl
For Each cBar In Application.CommandBars
If cBar.Name <> "Clipboard" Then
Set cBarCtrl = cBar.FindControl(ID:=ctlId, recursive:=True)
If Not cBarCtrl Is Nothing Then cBarCtrl.Enabled = Enabled
End If
Next
End Sub

Sub CutCopyPasteDisabled()
'Inform user that the functions have been disabled
MsgBox "Sorry! Knippen, kopiëren en plakken is uitgeschakeld!"
End Sub


Private Sub Workbook_Activate()
Call ToggleCutCopyAndPaste(False)
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call ToggleCutCopyAndPaste(True)
End Sub

Private Sub Workbook_Deactivate()
Call ToggleCutCopyAndPaste(True)
End Sub

Private Sub Workbook_Open()
Call ToggleCutCopyAndPaste(False)
End Sub
 
Geen idee waarom je dat allemaal zou willen, maar zet deze er eens bij:
Code:
Application.DisplayFormulaBar = False
 
Zoals gezegd zou ik dit willen om de layout te beschermen. Door dat gebruikers kunnen kopieren/knippen en plakken kunnen de cellen veranderen van kleur en raken samengevoegde cellen gesplitst.
De cellen moeten echter wel gedeblokkeerd zijn om gegevens te kunnen invoeren.

Voeg ik hem er dan bij zoals onderstaand (in het rood)

'*** In a standard module ***
Option Explicit

Sub ToggleCutCopyAndPaste(Allow As Boolean)
'Activate/deactivate cut, copy, paste and pastespecial menu items
Call EnableMenuItem(21, Allow) ' cut
Call EnableMenuItem(19, Allow) ' copy
Call EnableMenuItem(22, Allow) ' paste
Call EnableMenuItem(755, Allow) ' pastespecial

'Activate/deactivate drag and drop ability
Application.CellDragAndDrop = Allow

'Activate/deactivate cut, copy, paste and pastespecial shortcut keys
With Application
Select Case Allow
Case Is = False
.OnKey "^c", "CutCopyPasteDisabled"
.OnKey "^v", "CutCopyPasteDisabled"
.OnKey "^x", "CutCopyPasteDisabled"
.OnKey "+{DEL}", "CutCopyPasteDisabled"
.OnKey "^{INSERT}", "CutCopyPasteDisabled"
Case Is = True
.OnKey "^c"
.OnKey "^v"
.OnKey "^x"
.OnKey "+{DEL}"
.OnKey "^{INSERT}"
End Select
End With
End Sub

Sub EnableMenuItem(ctlId As Integer, Enabled As Boolean)
'Activate/Deactivate specific menu item
Dim cBar As CommandBar
Dim cBarCtrl As CommandBarControl
For Each cBar In Application.CommandBars
If cBar.Name <> "Clipboard" Then
Set cBarCtrl = cBar.FindControl(ID:=ctlId, recursive:=True)
If Not cBarCtrl Is Nothing Then cBarCtrl.Enabled = Enabled
End If
Next
End Sub

Sub CutCopyPasteDisabled()
'Inform user that the functions have been disabled
MsgBox "Sorry! Knippen, kopiëren en plakken is uitgeschakeld!"
End Sub

Private Sub Workbook_Activate()
Call ToggleCutCopyAndPaste(False)
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call ToggleCutCopyAndPaste(True)
End Sub

Private Sub Workbook_Deactivate()
Call ToggleCutCopyAndPaste(True)
End Sub

Private Sub Workbook_Open()
Call ToggleCutCopyAndPaste(False)
End Sub

Application.DisplayFormulaBar = False
 
Ik geloof niet dat je snapt wat de bedoeling is.
Die opdracht moet uiteraard wel in de juiste sub worden geplaatst.
 
Laatst bewerkt:
MEt de volgende Eventcode kun je elke plak actie afvangen en terugdraaien..

Dus als je dan een optie hebt gemist bij het afschermen, lukt het alsnog niet om data te plakken..
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim lastAction As String

  ' Get the last action performed by user
  lastAction = Application.CommandBars("Standard").Controls("&Undo").List(1)

  ' Check if the last action was a paste
  If Left(lastAction, 5) = "Paste" Then
        With Application
            .EnableEvents = False
            .Undo
            .EnableEvents = True
        End With
  MsgBox prompt:="Knippen en plakken niet toegestaan"
  End If
  

End Sub

Deze eventcode plaats je in de werkblad-modules van de werkbladen waar je niet wil dat er geplakt wordt.
 
MEt de volgende Eventcode kun je elke plak actie afvangen en terugdraaien..

Dus als je dan een optie hebt gemist bij het afschermen, lukt het alsnog niet om data te plakken..
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim lastAction As String

  ' Get the last action performed by user
  lastAction = Application.CommandBars("Standard").Controls("&Undo").List(1)

  ' Check if the last action was a paste
  If Left(lastAction, 5) = "Paste" Then
        With Application
            .EnableEvents = False
            .Undo
            .EnableEvents = True
        End With
  MsgBox prompt:="Knippen en plakken niet toegestaan"
  End If
  

End Sub

Deze eventcode plaats je in de werkblad-modules van de werkbladen waar je niet wil dat er geplakt wordt.

Ik heb hem er nu onder geplakt op deze manier
....
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call ToggleCutCopyAndPaste(True)
End Sub

Private Sub Workbook_Deactivate()
Call ToggleCutCopyAndPaste(True)
End Sub

Private Sub Workbook_Open()
Call ToggleCutCopyAndPaste(False)
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastAction As String

' Get the last action performed by user
lastAction = Application.CommandBars("Standard").Controls("&Undo").List(1)

' Check if the last action was a paste
If Left(lastAction, 5) = "Paste" Then
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
End With
MsgBox prompt:="Knippen en plakken niet toegestaan"
End If


End Sub

Maar hij werkt niet helemaal. Als ik plak dan krijg ik deze melding. Als ik op beeindigen druk wordt alsnog de plakactie uitgevoerd.
KOPIEREN PLAKKEN 3.jpg

Ik krijg deze foutopsporing
KOPIEREN PLAKKEN 4.jpg
 
Laatst bewerkt:
Lees de laatste regel in #5 nog eens.
 
Ik denk dat ik iets meer ondersteuning nodig heb met het goed plaatsen van de code.

op betreffende werkblad kies ik dan rechtermuisknop > invoegen > module om vervolgens daar de code te plakken?
 
Nee.
Dubbelklikken op het betreffende werkblad linksboven.
Dan in het codegedeelte plakken.
 
Nee.
Dubbelklikken op het betreffende werkblad linksboven.
Dan in het codegedeelte plakken.

Dan had ik het goed gedaan en kom ik met het plakken van de code uit post #5 met het resultaat zoals post #6

Met de code die u gegeven had zie ik helemaal geen verandering.
 
Plaats dan je document want in je voorbeeldcode in #6 staan de Worbook en Worksheet events door elkaar heen en dat is uiteraard fout.
 
Top bedankt hiervoor! Maar ondanks dat de codes nu juist erin staan werkt de kopieren/knippen en plakken functie in de werkbalk nog steeds zie ik.
 
Je bedoelt de formulebalk?
Die zou ook weg moeten zijn, hier zie ik die in ieder geval niet meer.
Heb je het over het document dat ik plaatste in #13 of over het eigenlijke document?
 
Klopt het document uit #13. De formulebalk is inderdaad weg maar dat lost mijn vraagstuk niet op. Ik zie ook dat je de code uit #5 hebt geplaatst in het bestand maar ook die veranderd niets.

In de werkbalk heb je onder het tab "start" de knoppen "plakken", "knippen" en "kopiëren". Deze zouden uitgeschakeld moeten worden.
 
Top bedankt hiervoor! Maar ondanks dat de codes nu juist erin staan werkt de kopieren/knippen en plakken functie in de werkbalk nog steeds zie ik.

ja dat klopt. Mijn code zorgt dat als er geknipt en geplakt wordt dit automatisch ongedaan wordt gemaakt. zo hoef je je niet (meer) af te vragen of er niet nog iemand ergens een methode vind om te plakken
dat leek mij een efficiënter dan heel excel te verbouwen om 1 dingetje te voorkomen.
Je doel is plakken voorkomen. dat gebeurt nu, althans het wordt direct ongedaan gemaakt en waarschuwt dat knippen en plakken niet is toegestaan.
Maar zelfs als je toch liever alles afschermt is deze code een goed vangnet voor als mensen toch weten te knippen en plakken..

Ik ben echter geen held in het aanpassen van de Ribbon.. (omdat ik het zelf nooit doe, teveel gepruts)
 
Laatst bewerkt:
ja dat klopt. Mijn code zorgt dat als er geknipt en geplakt wordt dit automatisch ongedaan wordt gemaakt. zo hoef je je niet (meer) af te vragen of er niet nog iemand ergens een methode vind om te plakken
dat leek mij een efficiënter dan heel excel te verbouwen om 1 dingetje te voorkomen.
Je doel is plakken voorkomen. dat gebeurt nu, althans het wordt direct ongedaan gemaakt en waarschuwt dat knippen en plakken niet is toegestaan.
Maar zelfs als je toch liever alles afschermt is deze code een goed vangnet voor als mensen toch weten te knippen en plakken..

Ik ben echter geen held in het aanpassen van de Ribbon.. (omdat ik het zelf nooit doe, teveel gepruts)

A oke ik snap de bedoeling van de code maar toch lijkt deze niet te werken.

Als ik kopieer en plak dan wordt de actie gewoon uitgevoerd en blijft ook zo staan. Daarmee wordt ook de layout verprutst wat ik wil beschermen. Je ziet nu dat de geplakte cel grijs is ipv wit wat hij was.

KOPIEREN PLAKKEN 5.jpg
 
Het werkt hier allemaal prima.
Tevens kan je het gebruik van het Klembord uit het lint verwijden in Opties/Lint aanpassen.

Dat zal echter per gebruiker moeten worden ingesteld.
Om het alleen voor dat document te doen zal je met CustomUI aan de slag moeten:
http://www.rondebruin.nl/win/s2/win016.htm
 
Vreemd, hier worden de kopieren/plakken acties echt niet teruggedraaid. Enig idee waarom het hier niet werkt?

Het lint kan ik inderdaad aanpassen maar dan heb ik het alleen voor mezelf opgelost. Als een andere gebruiker/account dit excel bestand opent en zijn/haar lint is niet aangepast dan ziet diegene gewoon de klembordopties.
Volgens mij is het aangepast lint gekoppeld aan het account, niet aan het bestand.

edit:
Ik zie dat je jou post aangevuld hebt, ik zal eens kijken om het per gebruiker in te stellen.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan