Opgelost aanpassing code

[lsc.b]

beste edmoor deze code heb ik van u gekregen en werkt prima

maar mijn volgende vraag zo je dit aan kunnen passen zodat ik het blad is beveiligd zoals het nu is maar dat ik dus enkel cellen
vrij kan geven ik heb het als een geprobeerd met ( range ("A1:B40") .unlocked = true ) maar dat krijg ik dus ook al niet voor elkaar ps. range a1: b40 is een voorbeeld

maar als er een ander Username gebruikt wordt moet alles wel weer beveiligd zijn
Private Sub Workbook_Open()

If Environ("Username") = "lsc.b" Then
For Each sh In ThisWorkbook.Sheets
sh.UnProtect "153"

Next sh
End If
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
For Each sh In ThisWorkbook.Sheets
sh.Protect "153"

Next sh
End Sub

 

[edmoor]

Die cellen kan je in de celeigenschappen op Unlocked zetten en heb je er vanuit de code geen omkijken naar.

 

[lsc.b]

Die cellen kan je in de celeigenschappen op Unlocked zetten en heb je er vanuit de code geen omkijken naar.

klopt maar als er een andere username gebruikt wordt staan die cellen ook op unlocked en dat moet dus niet dan moet alles weer beveiligd zijn ( het blad is dan wel beveiligd maar de cel niet )

 

[edmoor]

Als de gebruikersnaam lsc.b is dan hoef je ze dus helemaal niet te blokkeren omdat het wachtwoord er dan af gaat.

 

[lsc.b]

klopt maar we moeten enkele cellen toch beveiligen
of te wel het blad ( gebruikersnaam lsc.b ) toch ook beveiligen op enkel cellen na
dus dan moet ook een andere gebruiker helemaal beveiligd zijn

 

[edmoor]

Als het wachtwoord er af is zijn alle cellen beschikbaar.
Die kan je dan niet individueel beveiligen.

 

[lsc.b]

dus een andere oplossing is er niet

 

[edmoor]

Je kan met VBA die range controleren.
Als het wachtwoord er niet op zit kan bij het verlaten van de cel worden gecontroleerd of de cel mag worden gewijzigd.
Dat kan in de Worksheet_Change.

 

[lsc.b]

kun je me een hint geven ( code ) nu snap ik het even niet

 

[edmoor]

Bijvoorbeeld dit achter het betreffende werkblad:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not ActiveSheet.ProtectContents Then
        If Not Intersect(Target, Range("A1:B40")) Is Nothing Then
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
            MsgBox "Deze cel mag niet worden gewijigd", vbExclamation
        End If
    End If
End Sub

 

[lsc.b]

helemaal duidelijk hier kan ik mee vooruit bedankt zo ver

 

[lsc.b]

Application.Undo #10 geeft foutmelding zodra ik gegevens copieeer naar elders in dezelfde sheet
hoe op te lossen

 

[edmoor]

Foutmeldingen zijn er niet om gebruikers te pesten maar geven een mogelijke oorzaak voor een probleem aan. Als je dus zegt een foutmelding te krijgen is het wel zo handig deze er ook bij te vermelden.

 

[lsc.b]

Bij de een is een foutmelding een fout bij de ander niet
Maar goed zodra ik gegevens wil copieeeren krijg ik de melding dat applicatie. Undo hapert daar blijft het dus hangen maar als ik de melding negeer en dan nog een keer op mijn macro van copieeeren druk werkt het wel dat vind ik raar

 

[edmoor]

Ik zie nog steeds de exacte foutmelding niet.

 

[lsc.b]

bedoel je deze

 

[edmoor]

Ze de tweede regel van dit er dan eens bij:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub

 

[lsc.b]

maakt het iets uit tussen welke regel

 

[edmoor]

Daar waar ik het liet zien.

 

[lsc.b]

bedankt tot zover is het opgelost tot heden geen melding meer gezien