Automatisch vergrendelen bij sluiten bestand

[davylenders123]

Ik heb een excel bestandje met een macro in this workbook

Dim lRij As Long
Dim sWsh As String
Dim sBer As String
Dim sNWrd As String
Dim sOWrd As String
Dim bNWrd As Boolean
Dim bChange As Boolean
'Zet deze code bij ThisWorkbook. LET OP:
'Je moet een verwijzing maken naar Microsoft Scripting Runtime.
'
'Dit doe je als volgt:
'- Ga naar EXTRA - MACRO - VISUAL BASIC EDITOR. (�f ALT-F11)
'- Ga naar EXTRA - VERWIJZINGEN
'- Vink Microsoft Scripting Runtime aan.
'- Klik op OK.
'Zonder bovenstaande handelingen zal de 2e regel van de code niet werken.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim lDate As Long
lRij = Worksheets("Logfile").Range("B" & Rows.Count).End(xlUp).Row
If lRij = 1 Then lRij = 2
If Worksheets(Worksheets.Count).Name = "Logfile" Then
    Worksheets("Logfile").Range("C" & lRij).Value = Now()
End If

If bChange = False Then
    ActiveWorkbook.Close SaveChanges:=False
End If
End Sub

Private Sub Workbook_Open()
Dim ldatum As Long
Dim lRij As Long

    On Error Resume Next
    If Worksheets(Worksheets.Count).Name <> "Logfile" Then
        Worksheets.Add after:=Worksheets(Worksheets.Count)
        Worksheets(Worksheets.Count).Name = "Logfile"
        Worksheets("Logfile").Range("B:C").NumberFormat = "d/m/yyyy h:mm:ss"
    End If
    With Worksheets("Logfile")
        .ShowAllData
        .Protect Password:="1230", userinterfaceonly:=True
        
        lRij = .Range("A" & Rows.Count).End(xlUp).Row
        ldatum = Now - 30
        With .Range("A2:C" & lRij)
            .AutoFilter 1, "<=" & ldatum
            With .SpecialCells(xlCellTypeVisible)
                If .Rows.Count > 1 And Rows.Index > 1 Then .EntireRow.Delete
            End With
        End With
        ActiveSheet.ShowAllData
        
        lRij = .Range("A" & Rows.Count).End(xlUp).Row + 1
        .Range("A" & lRij).Value = ActiveWorkbook.BuiltinDocumentProperties("Last Author")
        .Range("B" & lRij).Value = Now
        .Visible = xlVeryHidden
'        ActiveWorkbook.Save
    End With
    
End Sub


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next

If Not Sh.Name = "Logfile" Then
    bChange = True
    If ActiveSheet.Name <> "Logfile" And bNWrd = False And Target.Count = 1 Then
        If Target.HasFormula Then
            sNWrd = Target.Formula
        ElseIf ActiveSheet.Name <> "Logfile" Then
            bNWrd = True
            sNWrd = Target.Value
            If sNWrd = ActiveSheet.Name Then sNWrd = ""
        End If
        invullen
    End If
End If
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.Name <> "Logfile" And Target.Count = 1 Then
    sWsh = ActiveSheet.Name
    sBer = ActiveCell.Address
    If ActiveCell.HasFormula Then
        sOWrd = ActiveCell.Formula
    Else
        sOWrd = ActiveCell.Value
        sNWrd = ""
    End If
End If
End Sub
Sub invullen()

Worksheets("Logfile").Protect Password:="1230", userinterfaceonly:=True
lRij = Worksheets("logfile").Range("A" & Rows.Count).End(xlUp).Row + 1
Worksheets("Logfile").Range("A" & lRij).Value = Application.UserName
Worksheets("Logfile").Range("B" & lRij).Value = Now
Worksheets("Logfile").Range("D" & lRij).Value = sWsh
Worksheets("Logfile").Range("E" & lRij).Value = sBer
Worksheets("Logfile").Range("F" & lRij).Value = sOWrd
Worksheets("Logfile").Range("G" & lRij).Value = sNWrd
bNWrd = False
'ActiveWorkbook.Save
End Sub

Het bestandje bestaat ui 7 tab bladen en ze zijn allemaal vergrendeld met een paswoord.
Die kan ik allemaal ineens ontgrendelen door op een buton te klikken en ze ook ieneens vergrendelen met een buton.(via macro)
Dit bestandje wordt door meerder personen gebruikt en regelmatig wordt vergeten de cellen terug te vergrendelen door op de vergrendel buton te klikken voor het sluiten.
Nu zou ik graag hebben dat elke keer als je het bestandje sluit automatisch de cellen worden vergrendeld met dat paswoord 00000.

En dat er elke keer een venster tevoorschijn komt of je het bestandje wil opslaan of niet ook als er geen wijzigingen zijn gebeurt.
(want het gebeurt dat we enkel bepaalde cellen moeten kleuren en als we dan gewoon sluiten zonder eerst op het opslaan icoon te klikken zijn de kleuren niet opgeslagen.)

 

[davylenders123]

kan niemand mij helpen ???