via vba gevulde cellen beveiligen

[knabbie]

Forummers

Ik heb een werkmap met 25 werkbladen beveiligd worden middels een code

 Sub beveiligingaanzetten()
'
' beveiligingaanzetten Macro

'  Beveiliging op sheets aanzetten
'sneltoets ctrl+i
    Dim mijnBlad As Worksheet
    For Each mijnBlad In Worksheets
          mijnBlad.Visible = True
          mijnBlad.Select
mijnBlad.Unprotect password:="" '<< is toegevoegd anders werkt controle op cellen niet

'>>>>>>>>>>>> van af hier gaat het niet goed <<<<<<<<<<<
  mijnBlad.Cells.SpecialCells(xlCellTypeConstants).Locked = True
      mijnBlad.Cells.SpecialCells(xlCellTypeFormulas).Locked = True
 '>>>>>>>>>>>> tot hier gaat het niet goed <<<<<<<<<<<
        mijnBlad.Protect password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True
            Next mijnBlad

    MsgBox "Alle werkbladen zijn nu beveiligd", vbOKOnly
    ThisWorkbook.Protect password:="", Structure:=True, Windows:=False
End Sub

Ik heb dit stukje

 >>>>>>>>>>>> van af hier gaat het niet goed <<<<<<<<<<<
  mijnBlad.Cells.SpecialCells(xlCellTypeConstants).Locked = True
      mijnBlad.Cells.SpecialCells(xlCellTypeFormulas).Locked = True
 '>>>>>>>>>>>> tot hier gaat het niet goed <<<<<<<<<<<

er tussen geplakt om de cellen die WEL gevuld zijn te kunnen locken,de resterende lege cellen die nog niet gelocked waren moeten unlocked blijven,maar dit werkt dus niet wat gaat er fout?

 

[knabbie]

Ik heb reeds een oplossing gevonden zie hieronder, het kan vast korter als dat zo is ik blijf nieuwsgierig.

Sub aanzet()
'
' aanzet Macro
' De macro is opgenomen op 31-3-2009
'
' Sneltoets: CTRL+i
'
 aantal_bladen = Worksheets.Count
For n = 1 To aantal_bladen
Sheets(n).Activate

  ActiveSheet.Unprotect password:="test"
On Error Resume Next
  ActiveSheet.Cells.SpecialCells(xlCellTypeConstants).Locked = True
  On Error Resume Next
   ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas).Locked = True

ActiveSheet.Protect password:="test"
Next n
MsgBox "Alle werkbladen zijn nu beveiligd", vbOKOnly
End Sub

 

[Wigi]

ongeteste code

Sub aanzet()

    Dim ws As Worksheet
    
    On Error Resume Next
    
    For Each ws In ThisWorkbook.Worksheets

        With ws
            .Unprotect Password:="test"
            .Cells.SpecialCells(xlCellTypeConstants).Locked = True
            .Cells.SpecialCells(xlCellTypeFormulas).Locked = True
            .Protect Password:="test"
        End With
    Next
    
    MsgBox "Alle werkbladen zijn nu beveiligd"
    
    On Error GoTo 0
    
End Sub

Wigi

 

[knabbie]

ongeteste code

wigi

bedankt voor jouw code ik ben er nog mee aan het stoeien of ik het stukje ook daadwerkelijk ga gebruiken in de totaal te gebruiken code.

Voor zover ik het nu kan bekijken werken meerdere codes uit dit draadje,
wat mij betreft Case closed

Dank voor de meedenkers