Worksheet beveiligen met VBA

[swaenie]

Hallo,

In Word 2003 werkte het. In Word 2007 niet.

Wat is het geval:
In VBA voeg ik voor het opslaan de code ActiveSheet.Protect (<wachtwoord>) toe. Na het opslaan wordt het betreffende Workbook automatisch gesloten. Open ik daarna het zojuist opgeslagen bestand, dan kan ik door simpel klikken op Beveiliging blad opheffen alle geblokkeerde velden bewerken, zonder het wachtwoord in te geven.

Kies ik handmatig voor Blad beveiligen, dan dien ik, om een veld te bewerken, wel eerst via Beveiliging blad opheffen mijn wachtwoord in te geven.

Wat begrijp ik niet, wat doe ik fout?

 

[danny147]

Beste swaenie

Zet de volledige code eens hier.

Groetjes Danny. :thumb:

 

[swaenie]

Hallo Danny,

Kan je hier iets mee?

Sub BewaarIndeling()

If IsDate(Cells(5, 3)) Then
Application.DisplayStatusBar = True
Application.StatusBar = "De indeling wordt opgeslagen...."
Application.ScreenUpdating = False

ActiveSheet.Unprotect (<wachtwoord>)

Workbooks.Add
ActiveSheet.Name = "Indeling GvAC"

'* vervolgens enkele kolom en rij instellingen *

'RecenteIndeling.xls is startbestand
Windows("RecenteIndeling.xls").Activate
Range("A1:J56").Select
Selection.Copy

Windows("Map1").Activate
Range("A1").Select
ActiveSheet.Paste

'* vervolgens paginainstellingen *

Cells.Select
Selection.Locked = True

ActiveWindow.Zoom = 100

Range("C6").Select
Application.CutCopyMode = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells

ActiveSheet.Protect (<wachtwoord>)

'Hier wordt een nieuw excel-document aangemaakt ter verspreiding
'Alleen dit scherm wordt uiteindelijk nog getoond
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.Path & "Indeling " & Format(Cells(5, 3), "yyyymm") & ".xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=True, _
CreateBackup:=False

Windows("RecenteIndeling.xls").Activate
Application.CutCopyMode = False

Range("C6").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells

ActiveSheet.Protect (<wachtwoord>)

'Omdat ik niet weet hoe de bestaande RecenteIndeling.xls te overschrijven
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.Path & "Temp.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Kill (PadNaam & "RecenteIndeling.xls")

ActiveWorkbook.SaveAs Filename:= _
PadNaam & "RecenteIndeling.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False

Kill (PadNaam & "Temp.xls")

ActiveWindow.Close

Application.StatusBar = False
Application.DisplayStatusBar = oudeStatusbalk
Application.ScreenUpdating = True
End If

 

[Warme bakkertje]

Begin al eens met je wachtwoord tussen dubbele aanhalingstekens te zetten

ActiveSheet.Protect "swaenie"

 

[swaenie]

Rudi,

<wachtwoord> betekent in dit geval het wachtwoord tussen aanhalingstekens.

 

[swaenie]

OPGELOST

Sub BewaarIndeling()

...

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
ActiveSheet.Protect (<wachtwoord>)

vervangen door:

ActiveSheet.EnableSelection = xlUnlockedCells
ActiveSheet.Protect password:=<wachtwoord>, Contents:=True, _
Scenarios:=False, DrawingObjects:=True, _
UserInterfaceOnly:=True

Workaround http://support.microsoft.com/kb/161221

...

'Omdat ik niet weet hoe de bestaande RecenteIndeling.xls te overschrijven
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.Path & "Temp.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Kill (PadNaam & "RecenteIndeling.xls")

ActiveWorkbook.SaveAs Filename:= _
PadNaam & "RecenteIndeling.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False

Kill (PadNaam & "Temp.xls")

vervangen door

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
PadNaam & "RecenteIndeling.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.DisplayAlerts = True

...

End If