Private Sub Workbook_BeforeClose(Cancel As Boolean)
Select Case ThisWorkbook.BuiltinDocumentProperties("Last Author") 'Controle of je schrijfbevoegd bent
Case "Gierman, Frank", _
"Laurman, Kees", _
"Extra naam"
Select Case MsgBox("Meneer Laurman, wil je het bestand opslaan voordat je het sluit?", vbYesNoCancel, "Opslaan") '3 keuze box openen, "Ja/Nee/Annuleren"
Case Is = vbYes 'Wanneer "Ja", opslaan op de locaties hieronder
Dim Origname As String
Application.DisplayAlerts = False
Sheets("Onderhoudsplan 2018").Protect Password:="Wachtwoord", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowSorting:=True, AllowFiltering:=True
ActiveWorkbook.SaveAs "I:\TDWerk-Teamleiders\TD MNL\" + ActiveWorkbook.Name
On Error GoTo 11
SetAttr "I:\Management-Dashboard_Loenen\Onderhoudsschema\" + ActiveWorkbook.Name, vbReadWrite 'Maak hier een ReadWrite van
ActiveWorkbook.SaveAs "I:\Management-Dashboard_Loenen\Onderhoudsschema\" + ActiveWorkbook.Name
SetAttr "I:\Management-Dashboard_Loenen\Onderhoudsschema\" + ActiveWorkbook.Name, vbReadOnly 'Maak hier een ReadOnly van
11:
With Sheets("Fouten") 'fout registratie in tabblad fouten
rij = .Cells(Rows.Count, "A").End(xlUp).Row + 1
.Cells(rij, 1) = Err.Number
.Cells(rij, 2) = Err.Description
.Cells(rij, 3) = Now()
.Cells(rij, 4) = Environ("username")
End With
MsgBox "Er ging iets niet goed met opslaan: " & vbNewLine & vbNewLine & "Opslag Management-Dashboard Loenen\Onderhoudsschema niet gelukt", vbOKOnly, "Fout"
On Error GoTo -1
On Error GoTo 12
SetAttr "I:\Management-Dashboard\Onderhoudsplanning\" + ActiveWorkbook.Name, vbReadWrite 'Maak hier een ReadWrite van
ActiveWorkbook.SaveAs "I:\Management-Dashboard\Onderhoudsplanning\" + ActiveWorkbook.Name
SetAttr "I:\Management-Dashboard\Onderhoudsplanning\" + ActiveWorkbook.Name, vbReadOnly 'Maak hier een ReadOnly van
12:
With Sheets("Fouten") 'fout registratie in tabblad fouten
rij = .Cells(Rows.Count, "A").End(xlUp).Row + 1
.Cells(rij, 6) = Err.Number
.Cells(rij, 7) = Err.Description
.Cells(rij, 8) = Now()
.Cells(rij, 9) = Environ("username")
MsgBox "Er ging iets niet goed met opslaan: " & vbNewLine & vbNewLine & "Opslag Management-Dashboard\Onderhoudsplanning (Eerbeek) niet gelukt", vbOKOnly, "Fout"
End With
Application.DisplayAlerts = True
Exit Sub 'Afsluiten bestand na het opslaan
Case Is = vbCancel 'Wanneer "Annuleren", terug naar bestand
Cancel = True
Case Is = vbNo 'Wanneer "Nee", afsluiten zonder opslaan
Application.DisplayAlerts = False
Application.Quit
Exit Sub 'Afsluiten "ingeval van gebruiker..."
End Select
Exit Sub
End Select
If ThisWorkbook.ReadOnly Then
Select Case MsgBox("Bestand wordt gesloten, opslaan is niet mogelijk! " _
& vbNewLine & vbNewLine & "Klik Ok om af te sluiten zonder op te slaan." & vbNewLine & "" _
& vbNewLine & "Klik annuleren en kies 'Opslaan als' om een persoonlijk bestand te maken." & vbNewLine & "", vbOKCancel, "ReadOnly bestand") 'Igv ReadOnly bestand deze POP-up
Case Is = vbCancel
Cancel = True
Case Is = vbOK 'Wanneer "Ok", afsluiten zonder opslaan
Application.DisplayAlerts = False
Application.Quit
End Select
End If
Select Case MsgBox("Bestand wordt gesloten, opslaan is niet mogelijk! " _
& vbNewLine & vbNewLine & "Klik Ok om af te sluiten zonder op te slaan." & vbNewLine & "" _
& vbNewLine & "Klik annuleren en kies 'Opslaan als' om een persoonlijk bestand te maken." & vbNewLine & "", vbOKCancel, "ReadOnly bestand") 'Indien je niet gebruiker ... bent deze POP-up
Case Is = vbCancel
Cancel = True
Case Is = vbOK 'Wanneer "Ok", afsluiten zonder opslaan
Application.DisplayAlerts = False
Application.Quit
Exit Sub
End Select
End Sub
