Beveiligingscode werkt niet!

[Cobbe]

Wie kan me uitleggen waarom deze code niet doet wat ze zou moeten doen, nl Vrijgeven en beveiligen:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Sheets(2)
Application.DisplayAlerts = False
    .Unprotect
If Selection.Count > 1 Or Intersect(Target, .Range("B5:G215")) Is Nothing Then Exit Sub
    .Range("B" & Target.Row & ":G" & Target.Row).ClearContents
      Target = "X": .Cells(Target.Row, "O") = Target.Column - 1
Application.DisplayAlerts = True
    .Protect
End With
End Sub

Hier is het bestand waarin dit zou moeten werken:

http://www.mijnbestand.nl/Bestand-X38GOWEACCOV.xlsm

 

[Niels28]

Dag Cobbe,

Als ik je bestandje test werkt het .
ik klik in een lege cel in kolom B:G
dan wordt het verbodsbord verplaats naar de cel waar ik 2x klikte

Het enige is dat de melding van de beveiliging blijft verschijnen, hoe je die weg krijgt weet ik niet.

Niels

 

[Cobbe]

Ja dat is eigenlijk juist het probleem.

Ik zie niet waarom die melding er komt te staan.

Er zitten geen koppelingen in het bestand(zover ik kan zien), en geen andere code die dit zou kunnen veroorzaken.

 

[Niels28]

Door de dubbelklik wordt eerst die melding veroorzaakt maar die wordt pas later weergegeven, dan heeft die displayalerts geen zin nut meer want dan is de melding eigenlijk al gegeven.
Probeer maar eens uit met een knop. Je krijg de melding dan niet.
het enige wat ik heb gedaan is je target vervangen door active cel.
Selecteer een cel in kolom B:G en klik dan op de knop.

Private Sub CommandButton1_Click()

With Sheets(2)

Application.DisplayAlerts = False
    .Unprotect
If Selection.Count > 1 Or Intersect(ActiveCell, .Range("B5:G215")) Is Nothing Then Exit Sub

    .Range("B" & ActiveCell.Row & ":G" & ActiveCell.Row).ClearContents
      ActiveCell = "X": .Cells(ActiveCell.Row, "O") = ActiveCell.Column - 1
Application.DisplayAlerts = True
    .Protect

End With
End Sub

Niels

 

[Cobbe]

Ge zijt een genie! Uw uitleg klopt als een bus.

Ik ga proberen via een selection_change-event de code werkend te krijgen.

Harstikke bedankt, het zweet breekt je soms uit als het niet lekker loopt.

Groetjes, Cobbe.

 

[Niels28]

Dan werkt het perfect, maar verplaats dan wel die .unprotect naar na het if intersect statement
anders heeft de beveiliging geen nut.

Niels

 

[Cobbe]

Heb een oplossing, dank zij Niels!!!! gevonden.

 

[Niels28]

Dag Cobbe,

Ik zou het zo doen anders hoef je het blad niet te beveiligen. omdat de beveiliging er anders bij het selecteren van elke willekeurige cel afgehaald wordt.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Application.DisplayAlerts = False
  If Selection.Count > 1 Or Intersect(Target, Range("B5:G215")) Is Nothing Then Exit Sub
[COLOR="#FF0000"]  Sheets("Soort waarde").Unprotect Password:=1234[/COLOR]    
Range("B" & Target.Row & ":G" & Target.Row).ClearContents
      Target = "R": Cells(Target.Row, "O") = Target.Column - 1

Sheets("Soort waarde").Protect Password:=1234
ActiveSheet.EnableSelection = xlNoRestrictions
Application.DisplayAlerts = False

End Sub

Niels

 

[Cobbe]

Ja je hebt natuurlijk gelijk!
Als je zenuwachtig wordt zie je zulke dingen niet meer op het laatst.

Bedankt voor de hulp!

Groeten, Cobbe