Automatisch cellen blokkeren + algemene blokkering tabblad

[Bandito]

Hallo allen,

Dacht je alles bij elkaar te hebben lukt het nog niet. Een tijd geleden heb ik gevraagd hoe je automatisch cellen blokkeert als je een paraaf invoert. Zie hier het perfect werkende resultaat (macro): Bekijk bijlage Blokkeren(EA).xlsm

Nu wil ik dit in mijn eigen bestand gaan toepassen, met wat simpele aanpassingen aan de macro. Helaas heb ik iets over het hoofd gezien.
In mijn document zijn er cellen die altijd geblokkeerd moeten zijn. Deze cellen mogen dus niet van de blokkering afgaan. Bijvoorbeeld de cellen in kolom B t/m F en de cellen in kolom N t/m P (klant). Met de simpele reden dat hier formules onder zitten die niet per ongeluk weggehaald mogen worden.

Wanneer ik mijn macro gebruik om cellen automatisch te blokkeren bij een bepaalde invoer (voer in kolom Q (paraaf) iets in en kolom M (debiteur nummer) moet blokkeren, botst dit met de cellen die altijd geblokkeerd moeten zijn. Ik krijg een melding om de beveiliging van het blad op te heffen. Dit is niet de bedoeling.

Iemand een idee hoe ik dit probleem kan oplossen?

Bekijk bijlage Voorbeeld.xlsx

 

[Cobbe]

Komt dit in de buurt?

 

[Bandito]

Hallo Cobbe,

Komt in de buurt maar het is het nog net niet

Wanneer ik iets in paraaf zet wordt deze cel ook geblokkeerd en kan ik de paraaf niet meer verwijderen. Het idee van het systeem is dat wanneer iemand een paraaf zet, bepaalde cellen (debiteurnummer en artikelnummer o.a.) niet per ongeluk kan veranderen. Natuurlijk kan het voorkomen dat ze iets fout hebben ingevoerd en dat ze dit willen verbeteren. Dit kan door de paraaf weer te verwijderen, vervolgens de fout te verbeteren, dan weer een paraaf zetten zodat de rij blokkeert.

De cel paraaf moet dus niet geblokkeerd worden.

Met vriendelijke groet,

 

[Cobbe]

Misschien mits deze kleine aanpassing dat het wel lukt:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("Q8:Q31")) Is Nothing Then Exit Sub
 ActiveSheet.Unprotect
 Dim cl As Range
On error goto oeps
 For Each cl In Range("Q8:Q31")
    cl.Offset(, -4).Resize(, 4).Locked = cl <> ""
 Next
oeps:
 ActiveSheet.Protect
End Sub

 

[Bandito]

Hallo Cobbe,

Helaas nog niet.

Ik zet iets in cel klant, vervolgens beveilig ik het blad en voer daarna jouw code in. Daarna zet ik iets in de cel paraaf en krijg dan de melding om het wachtwoord in te voeren om het werkblad te ontgrendelen. Het botst dus nog.

Nog enig idee? Hoop echt dat mijn idee uitvoerbaar is.

Met vriendelijke groet,

 

[Cobbe]

Het heeft met de blokkering van de cellen te doen, je moet eerst alle cellen van het bereik(of blad) via celeigenschappen - Bescherming - Blokkeren.
Dan doe je alle cellen die gewijzigd moeten/kunnen worden via dezelfde weg deblokkeren.

Als je dan iets wijzigt in de kolom Paraaf loopt het wel goed(denk ik toch).

 

[Bandito]

Hey Cobbe,

Ik heb het precies gedaan zoals jij mij vertelde maar dan loopt het helaas niet goed. Wanneer ik dan iets wijzig in kolom Paraaf krijg ik de melding: beveilig blad opheffen

 

[Bandito]

!

Ik denk dat ik het probleem heb gevonden!
Als ik het blad beveilig gaf ik telkens een wachtwoord in en liet dit niet leeg. daarom vroeg hij steeds om het wachtwoord als hij wou deblokkeren / blokkeren.

Nu ik geen wachtwoord invoer als ik de cellen blokkeer krijg ik dit niet. Volgens mij is dit hem. Ik ga nog even verder "testen"

 

[Cobbe]

Ja had ik eigenlijk ook moeten aangeven maar tja..
Je kan dat ook in de code opvangen door een paswoord in te geven in de code zelf:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("Q8:Q31")) Is Nothing Then Exit Sub
 ActiveSheet.Unprotect [COLOR="#FF0000"]Password:=1234[/COLOR]
 Dim cl As Range
On Error GoTo oeps
 For Each cl In Range("Q8:Q31")
    cl.Offset(, -4).Resize(, 4).Locked = cl <> ""
 Next
oeps:
 ActiveSheet.Protect [COLOR="#FF0000"]Password:=1234[/COLOR]
End Sub

 

[Bandito]

Hallo Cobbe,

Allereerst heel hartelijk dank voor je inzet! Zonder jou zat ik nog steeds op hetzelfde punt.

Er zit nu nog 1 klein "foutje" in.

Hij doet het perfect totdat ik de waarde in cel paraaf weghaal. Op een of andere manier verdwijnt dan ook de beveiliging op de cel klant. Wanneer ik er weer een paraaf zet komt deze beveiliging er wel weer op. Er is dus een moment dat je per ongeluk iets kan verwijderen uit de cel klant. Dit is niet de bedoeling.

Dus de cel klant is geblokkeerd, ik zet een paraaf en de cel debiteurnummer is ook geblokkeerd. Dit klopt dus tot nog toe. Ik haal de paraaf weg omdat ik debiteurnummer wil veranderen, dit kan maar ik kan nu ook in de cel klant dingen veranderen omdat daar de blokkering ook weg is. Dit klopt dus niet. Ik zet weer een paraaf en zowel debiteurnummer als klant blokkeren weer. Er is dus een kort moment dat klant ongeblokkeerd raakt.

Met vriendelijke groet,

 

[Cobbe]

Dan zal het wel lukken met deze kleine aanpassing:

Private Sub Worksheet_Change(ByVal Target As Range)
'Deze code werkt enkel als er een wijziging is in bereik Q8:Q31
If Intersect(Target, Range("Q8:Q31")) Is Nothing Then Exit Sub
' Haal eerst de beveiliging van het werkblad af.
 ActiveSheet.Unprotect Password:=1234
 Dim cl As Range
'Als er een foutje zou optreden netjes afsluiten.
On Error GoTo oeps
'Loop het hele bereik Q8:Q31 door.
 For Each cl In Range("Q8:Q31")
' (De)Blokkeer de cellen met de gegevens : nummer en omschrijving indien er een paraaf komt of niet.
    cl.Offset(, -4).Resize(, 4).Locked = cl <> ""
'Bij deblokkering toch de cellen met omschrijving blokkeren.
    cl.Offset(, -3).Resize(, 3).Locked = True
'Volgende cel.
 Next
'Beveiligen en Afsluiten.
oeps:
 ActiveSheet.Protect Password:=1234
End Sub

De groen regels zijn commentaarregels en hebben geen invloed op de code.

Mod edit: Kleuren verwijderd. Er zijn mensen die kleurenblind zijn of bepaalde contrasten moeilijk kunnen onderscheiden.

 

[Bandito]

Hey Cobbe,

Het werk perfect! Hartelijk dank!

Nu heb ik nog 2 klein vraagjes, en je zult wel denken hij blijft maar vragen, maar ik beloof je dat dit de laatste zullen zijn als het werkt

Het lijkt of je ondertussen gedachte kan lezen want ik wilde inderdaad vragen of je de code kon uitleggen zodat ik hem uit kon breiden. Ik heb hem geprobeerd uit te breiden maar het loopt nog niet lekker. Dit heb ik er van gemaakt:

Private Sub Worksheet_Change(ByVal Target As Range)
'Deze code werkt enkel als er een wijziging is in bereik Q8:Q31
If Intersect(Target, Range("Q8:Q31")) Is Nothing Then Exit Sub
' Haal eerst de beveiliging van het werkblad af.
 ActiveSheet.Unprotect Password:=1234
 Dim cl As Range
'Als er een foutje zou optreden netjes afsluiten.
On Error GoTo oeps
'Loop het hele bereik Q8:Q31 door.
 For Each cl In Range("Q8:Q31")
' (De)Blokkeer de cellen met de gegevens : nummer en omschrijving indien er een paraaf komt of niet.
    cl.Offset(, -4).Resize(, 4).Locked = cl <> ""
    [B]cl.Offset(, -6).Resize(, 6).Locked = cl <> ""[/B]
'Bij deblokkering toch de cellen met omschrijving blokkeren.
    cl.Offset(, -3).Resize(, 3).Locked = True
    [B]cl.Offset(, -5).Resize(, 5).Locked = True[/B]
    
'Volgende cel.
 Next
'Beveiligen en Afsluiten.
oeps:
 ActiveSheet.Protect Password:=1234
End Sub

Het dik gedrukte heb ik toegevoegd om te kijken of ik meer cellen op deze manier kan blokkeren / deblokkeren.
Het blijkt toch niet zo makkelijk uit te breiden te zijn voor mij. Ik heb een voorbeeld bestandje gemaakt. Bekijk bijlage Bandito2.xlsm

Ik zou graag willen dat de licht rode cellen altijd geblokkeerd zijn en dat de lichte groen geblokkeerd en ge deblokkeerd kunnen worden met paraaf.
Wat doe ik fout om jouw code uit te breiden?


*2 is er een mooie manier om aan te geven dat ze hun paraaf moeten verwijderen alvorens ze de cel aan kunnen passen ipv de standaard fout melding van excel als ze iets proberen te veranderen in een cel. Dit is bijzaak, als het teveel werk is laat dit achterwege.

Met vriendelijke groet,

 

[Cobbe]

Kijk eens of hij nu goed gaat.
Die rode driehoekjes is wel niet mooi maar wel effectief.
Zal eens kijken of ik geen properder oplossing kan bedenken voor dit probleem.

 

[Bandito]

Hey Cobbe, het werkt als een zonnetje!

Heel erg bedankt!

Mocht je nog op een properdere oplossing komen voor de rooie driehoekjes dan hoor ik dit vast

Met vriendelijke groet,

 

[Cobbe]

Draai deze code eenmaal om die rode driehoekjes een beetje te camoufleren. Doe dit wel eerst op een copij van je bestand.
Als het resultaat bevalt laat je hem in je bestand lopen. Kleur 57 kan je aanpassen met een eventueel betere groen kleur.
Beetje zoeken en proberen:

Sub CoverCommentIndicator()
Set ws = ActiveSheet
shpW = 6
shpH = 4

For Each cmt In ws.Comments
  Set rngCmt = cmt.Parent
  With rngCmt
    Set shpCmt = ws.Shapes.AddShape(msoShapeRightTriangle, _
      rngCmt.Offset(0, 1).Left - shpW, .Top, shpW, shpH)
  End With
  With shpCmt
    .Flip msoFlipVertical
    .Flip msoFlipHorizontal
    .Fill.ForeColor.SchemeColor = 57   
    .Fill.Visible = msoTrue
    .Fill.Solid
    .Line.Visible = msoFalse
  End With
Next cmt
End Sub

 

[Bandito]

Hallo Cobbe,

Bedankt voor alles!
Erg bedankt voor hoe je de tijd voor mijn probleem hebt genomen!

Met vriendelijke groet,