Pop-up bij fout macro tijdens afsluiten/opslaan

Frankell87 · 17 apr 2018

Hallo,

Ik probeer een bestand op meerdere plaatsen op ons interne netwerk op te slaan. Niet iedereen kan namelijk overal bijkomen en dit geeft het voordeel dat we het bestand niet hoeven te kopieeren met de kans op fouten.
Er zijn een aantal personen die wel alle toegang en schrijfbevoegdheid hebben. (niet iedereen hoeft er ook dingen in te wijzigen)

Zodra ik de macro laat lopen die ik tot nu toe heb doet hij bij mij precies wat hij moet doen, bij het afsluiten komt hij met een pop-up of je wil opslaan of niet of wil annuleren. Bij het opslaan doet hij dat in 3 verschillende mappen (worden er meer).

MAAR, zodra iemand anders die niet de juiste bevoegdheden heeft een wijziging aanbrengt, afsluit en hem wil opslaan komt er een foutmelding van de macro en stopt hij. Zeker een leek weet nu niet wat er is gebeurt en of hij uberhaubt is opgeslagen. Als je de macro nu zou stoppen gaat hij verder met afsluiten.

Graag zou ik zien dat er alleen een POP-up komt die aangeeft in welke map hij niet heeft kunnen opslaan. Waarna de keuze er is om toch af te sluiten zonder dat wijzigingen in alle mappen zijn doorgevoerd. (Dus weer pop-up met keuze afsluiten ja/nee) Eerdere mappen waar de macro al wel langs is geweest zijn dan waarschijnlijk al aangepast

onderstaand de macro die ik nu heb:

Code:

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Select Case MsgBox("Wil je het bestand opslaan voor het sluiten?", vbYesNoCancel)
    
Case Is = vbYes
        
    Dim Origname As String

        Application.DisplayAlerts = False
    
            ActiveWorkbook.SaveAs "C:\map 1" + ActiveWorkbook.Name
       
            ActiveWorkbook.SaveAs "C:\map 2" + ActiveWorkbook.Name

            ActiveWorkbook.SaveAs "C:\map 3" + ActiveWorkbook.Name
    
        Application.DisplayAlerts = True

Case Is = vbCancel
    Cancel = True
    
Case Is = vbNo
    ThisWorkbook.Saved = True
    Exit Sub
    
End Select

End Sub

snb · 17 apr 2018

Gebruik svp code tags rondom de VBA-code.

Zie: http://www.helpmij.nl/forum/announcement.php?f=5

edmoor · 17 apr 2018

Als je zegt een foutmelding te krijgen vertel er dan ook bij welke dat is.
Plaats tevens je code in codetags, zo is het niet te lezen.
Probeer deze eens en laat dan weten wat er gebeurt:

Code:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Select Case MsgBox("Wil je het bestand opslaan voor het sluiten?", vbYesNoCancel)
        Case vbYes
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs "C:\map 1\" & ActiveWorkbook.Name
            ActiveWorkbook.SaveAs "C:\map 2\" & ActiveWorkbook.Name
            ActiveWorkbook.SaveAs "C:\map 3\" & ActiveWorkbook.Name
            Application.DisplayAlerts = True
            
        Case vbCancel
            Cancel = True
            
        Case Is = vbNo
            ThisWorkbook.Saved = True
    End Select
End Sub

Frankell87 · 17 apr 2018

Excuus

ik wist niet hoe dat moest met die tags, zag dat mijn code er al was ingezet.
de melding die ik krijg is onderstaand:

Code:

Fout 1004 tijdens uitvoering:

Methode SaveAs van object_workbook is mislukt

Wanneer ik op 'Foutopsporing' klik wordt de regel geel waar ik geen schrijfrecht op heb.

iedereen bedankt voor de input!

edmoor · 17 apr 2018

Heb je dat gedaan met de code die ik plaatste?
Welke regel wordt er dan geel?

Frankell87 · 17 apr 2018

Nee, ik heb op de 2 regel een adres ingevuld van ons interne netwerk waarop ik alleen leesrecht heb en geen schrijfrecht.

dit 2e adres wordt dan geel.

Heb onderstaand een screenshot.

edmoor · 17 apr 2018

Wat wil je dat er precies gebeurt als zo'n fout zich voordoet?

Frankell87 · 18 apr 2018

Graag zou ik een melding krijgen die aangeeft in welke map het mis ging, dus bijvoorbeeld: "Opslaan mislukt in Map2".

andere opties (weet niet of dat kan):
- voordat het bestand wordt opgeslagen controleren of opslaan wel kan en dan evt een pop-up als er schrijfrecht ontbreekt.
- na het doorlopen van het opslaan een pop-up waarin staat:
- Opslag geslaagd in Map1
- Opslag geslaagd in Map2
- Opslag mislukt in Map3

snb · 18 apr 2018

En waar is dat dan goed voor ?

Frankell87 · 18 apr 2018

zodat de gebruiker geattendeerd is op het feit dat het bestand niet goed is opgeslagen.

of heeft u misschien betere ideeen?

snb · 18 apr 2018

En wat kan de gebruiker daarmee ?

Het antwoord op je vraag is: ja.

Frankell87 · 18 apr 2018

nou kom maar op!

snb · 18 apr 2018

Wat is je antwoord op mijn vraag ?

Frankell87 · 18 apr 2018

Ik heb nu onderstaande erin staan, tijdens het openen van het bestand wordt gekeken wie je bent en afhankelijk daarvan maakt hij er een ReadOnly van:

Code:

Private Sub Workbook_Open()
    Select Case ThisWorkbook.BuiltinDocumentProperties("Last Author") 'Controle of je schrijfbevoegd bent
        Case "Gierman, Frank", _
        "Pietje", _
        "Jantje"
            Exit Sub
    End Select

    Application.DisplayAlerts = False
    ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly
    Application.DisplayAlerts = True
    MsgBox "Document geopend in Alleen lezen modus, alleen Kees Laurman kan wijzigingen aanbrengen.", vbInformation, "Schrijfbevoegdheden ontbreken"
End Sub

Dit bovenstaande heb ik proberen te verwerken in het afsluiten van het bestand. Hij werkt inmiddels goed maar heb nog 1 schoonheidsvraagje. Kan deel 2 van de tekst in de laatste MsgBox 2 regels later laten beginnen? Dus dat er dit staat:

Code:

Bestand wordt gesloten, opslaan is niet mogelijk! 

Klik annuleren en kies 'Opslaan als' om een persoonlijk bestand te maken.

Macro die ik nu heb is dit:

Code:

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Select Case ThisWorkbook.BuiltinDocumentProperties("Last Author") 'Kijken of de gebruiker wel ... is
        Case "Gierman, Frank", _
                "Pietje", _
                "Jantje"
            
            Select Case MsgBox("Wil je het bestand opslaan voor het sluiten?", 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
                        ActiveWorkbook.SaveAs "C:\map 2\" + ActiveWorkbook.Name
                        ActiveWorkbook.SaveAs "C:\map 1\" + ActiveWorkbook.Name
                    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
                  ThisWorkbook.Saved = True
            Exit Sub 'Afsluiten "ingeval van gebruiker..."
    End Select
    End Select 'Einde "ingeval van gebruiker..."
    
Select Case MsgBox("Bestand wordt gesloten, opslaan is niet mogelijk! Klik annuleren en kies 'Opslaan als' om een persoonlijk bestand te maken.", vbOKCancel, "ReadOnly bestand") 'Indien je niet gebruiker ... bent deze POP-up
        Case Is = vbCancel
        Cancel = True
        
End Select
End Sub

trainers · 19 apr 2018

Zoiets:

Code:

MsgBox Title:="Frank Gierman", Buttons:=vbOKCancel, prompt:="Bestand wordt gesloten, opslaan is niet mogelijk! " _
                & vbNewLine & vbNewLine & "Klik annuleren en kies 'Opslaan als' om een persoonlijk bestand te maken." & vbNewLine & vbNewLine & ""

edmoor · 19 apr 2018

Je hoeft niet nogmaals op de namen te controleren, enkel kijken of het document ReadOnly is is voldoende.
Dat kan met dit:
If ThisWorkbook.ReadOnly Then

Frankell87 · 19 apr 2018

Thanks!! werkt perfect!

trainers zei:

Zoiets:

Code:

MsgBox Title:="Frank Gierman", Buttons:=vbOKCancel, prompt:="Bestand wordt gesloten, opslaan is niet mogelijk! " _
                & vbNewLine & vbNewLine & "Klik annuleren en kies 'Opslaan als' om een persoonlijk bestand te maken." & vbNewLine & vbNewLine & ""

Frankell87 · 19 apr 2018

edmoor zei:
Je hoeft niet nogmaals op de namen te controleren, enkel kijken of het document ReadOnly is is voldoende.
Dat kan met dit:
If ThisWorkbook.ReadOnly Then

Thanks, heb hem aangepast, wordt het weer een stukje korter en makkelijker van.

Dit heb ik nu (Open en BeforeClose):

Code:

Private Sub Workbook_BeforeClose(Cancel As Boolean)

If Not ThisWorkbook.ReadOnly Then
            
            Select Case MsgBox("Meneer Gierman, 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
                        ActiveWorkbook.SaveAs "C:\map 2\" + ActiveWorkbook.Name
                        ActiveWorkbook.SaveAs "C:\map 1\" + ActiveWorkbook.Name
                    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
                  ThisWorkbook.Saved = True
            Exit Sub 'Afsluiten "ingeval van gebruiker..."
    End Select
    End If
        
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") 'Indien je niet gebruiker ... bent deze POP-up
        Case Is = vbCancel
        Cancel = True
        
End Select
End If
End Sub

Private Sub Workbook_Open()
    Select Case ThisWorkbook.BuiltinDocumentProperties("Last Author") 'Controle of je schrijfbevoegd bent
        Case "Gierman, rank", _
        "Pietje", _
        "Jantje"
            Exit Sub
    End Select

    Application.DisplayAlerts = False
    ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly
    Application.DisplayAlerts = True
    MsgBox "Document geopend in Alleen lezen modus, alleen Frank Gierman kan wijzigingen aanbrengen.", vbInformation, "Schrijfbevoegdheden ontbreken" 'Melding dat het bestand is geopend als ReadOnly
End Sub

edmoor · 19 apr 2018

Korter is altijd leuk natuurlijk, maar belangrijker is dat je nu niet een lijstje met namen op 2 verschillende plekken moet onderhouden.

Frankell87 · 19 apr 2018

Klopt!

Super dit zo!

bedankt voor je tijd! ik zal beide topics op opgelost zetten.

Pop-up bij fout macro tijdens afsluiten/opslaan

Gebruiker

Verenigingslid

Inventaris

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Verenigingslid

Gebruiker

Verenigingslid

Gebruiker

Verenigingslid

Gebruiker

Verenigingslid

Inventaris

Gebruiker

Gebruiker

Inventaris

Gebruiker

Wij waarderen jouw privacy