Monkey proof opslaan

[HaBro]

Hallo

Ik heb op deze site een geweldige code gevonden om 1 blad op te slaan
en dat werkt perfect
Maar.....
ik zou heel graag dit progr monkey proof hebben
en als ik met deze code per ongeluk de zelfde naam heb voor op te slaan
geeft Excel aan dat deze file naam al bestaat.
met de vraag opnieuw of niet opslaan of annuleren
als ik op nee of annuleren druk krijg ik een fout melding in VBA
en stopt het halverwege een alle berekeningcodes in het blad ben ik dan kwijt

Is er een mogelijkheid om deze fout melding te voor komen
en dan wel met deze code omdat er bepaalde plaatjes en teksten niet mee gecop.
worden..

Dim sBestandsnaamNieuw As String

ActiveSheet.Unprotect

    With Sheets("Rapport")
       sBestandsnaamNieuw = Sheets("Instelling").Range("L20").Value & ".xls"

       '' sBestandsnaamNieuw = .Range("C2").Value & ".xls"
        .Copy
    End With
    
    With Cells
        .Copy
        .PasteSpecial xlPasteValuesAndNumberFormats, xlNone, False, False
        .Range("A1").Select
    End With
    ActiveSheet.Shapes("Picture 5").Delete
    ActiveSheet.Shapes("Picture 45").Delete
    ActiveSheet.Shapes("Picture 46").Delete
    ActiveSheet.Shapes("Picture 2").Delete
    ActiveSheet.Range("C59:J59").Delete
    ''ActiveSheet.Range("B98:D101").Select
    Selection.ClearContents
    ActiveSheet.Range("A1").Select
    
    ActiveWorkbook.SaveAs "C:\Test" & sBestandsnaamNieuw, xlNormal  '  "C:\Test\" & sBestandsnaamNieuw, xlNormal
    ActiveWorkbook.Close
    

MsgBox "Deze File is succes vol opgeslagen"

Sheets("Instelling").Select
Range("I22").Value = Range("I22").Value + 1
Sheets("Rapport").Select
ActiveWindow.ScrollRow = 29
ActiveSheet.Unprotect
End Sub

 

[jzeedijk]

Hoi Habro,

Probeer het hiermee:
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= "C:\Test" & sBestandsnaamNieuw, xlNormal
Application.DisplayAlerts = True

Dit schakelt de waarschuwingen tijdelijk uit.

Jeroen

 

[HaBro]

GEWELDIG

Dat werkt
Hartelijk dank

Hans