Bekijk de onderstaande video om te zien hoe je onze site als een web app op je startscherm installeert.
Opmerking: Deze functie is mogelijk niet beschikbaar in sommige browsers.
Privacywetgeving
Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.
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"
Resume Next
On Error GoTo 0
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")
End With
MsgBox "Er ging iets niet goed met opslaan: " & vbNewLine & vbNewLine & "Opslag Management-Dashboard\Onderhoudsplanning (Eerbeek) niet gelukt", vbOKOnly, "Fout"
Resume Next
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
Trouwens, vbReadWrite heb ik niet, wel vbNormal.
Ik vraag me dan af hoe je daar bij kwam want die komt niet voor in de pagina die ik je gaf met uitleg over het gebruik van SetAttr.
ik heb geen idee edmoor, daar staat idd vbNormal.
Als je altijd 'on error resume next' of 'on error goto' gebruikt, werkt alles/niets.
Gebruik 1 On Error afhandeling. Je kan gewoon in een variabele bijhouden in welk gedeelte van de code je zit en dat in tevens in de foutlog vermelden.
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
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, vbNormal 'Maak hier een Normal 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")
.Cells(rij, 5) = "Loenen"
End With
Resume Next
MsgBox "Er ging iets niet goed met opslaan: " & vbNewLine & vbNewLine & "Opslag Management-Dashboard Loenen\Onderhoudsschema niet gelukt", vbOKOnly, "Fout"
On Error GoTo 0
On Error GoTo 12
SetAttr "I:\Management-Dashboard\Onderhoudsplanning\" + ActiveWorkbook.Name, vbNormal 'Maak hier een Normal 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, 1) = Err.Number
.Cells(rij, 2) = Err.Description
.Cells(rij, 3) = Now()
.Cells(rij, 4) = Environ("username")
.Cells(rij, 5) = "Eerbeek"
End With
Resume Next
MsgBox "Er ging iets niet goed met opslaan: " & vbNewLine & vbNewLine & "Opslag Management-Dashboard\Onderhoudsplanning (Eerbeek) niet gelukt", vbOKOnly, "Fout"
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
Sub Test()
Dim Sectie As String
On Error GoTo Foutje
Sectie = "A"
ActiveWorkbook.SaveCopyAs "A:\a.a"
Sectie = "B"
ActiveWorkbook.SaveCopyAs "B:\b.b"
Exit Sub
Foutje:
With Sheets("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")
.Cells(rij, 5) = Sectie
End With
MsgBox "Er is iets mis gegaan, gegevens zijn mogelijk niet goed opgeslagen", vbCritical
Resume Next
End Sub
We gebruiken essentiële cookies om deze site te laten werken, en optionele cookies om de ervaring te verbeteren.