Macro salva copia, in errore su avviso di file già esistente

Question

Scusate apro un altro trend per un problema che mi si è presentato con una macro che gentilmente mi aveva passato Mauro (che saluto), la discussione era questa:

http://social.answers.microsoft.com/Forums/it-IT/officeexcelit/thread/381cd49a-cdbd-4f31-9540-54262ac17fdc

Ho tentato di adattare la macro alle mie esigenze, questo il risultato:

Private Sub CommandButton1_Click()

'<---In questa prima parte utilizzo un foglio di appoggio "CopiaAnno" per salvare poi da questo una copia (senza formattazione e pulsanti vari che ho sul foglio originale "Anni")

Application.ScreenUpdating = False

Sheets("CopiaAnno").Visible = True

Sheets("CopiaAnno").Range("A1:H1000").ClearContents

Sheets("Anni").Columns("A:H").Copy

    Sheets("CopiaAnno").Select

    Sheets("CopiaAnno").Range("A1").Select

    Range("A1").Select

    Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _

        SkipBlanks:=False, Transpose:=False

    Range("A1").Select

    Sheets("Anni").Select

    Range("I1").Select

    Application.CutCopyMode = False

    Range("A3").Select

    Dim sh As Worksheet

    Dim sPath As String

    Dim sNomeFile

    Dim lRisposta As Long

'<---A seguire il codice originale

    Set sh = ThisWorkbook.Worksheets("CopiaAnno")

    sPath = ThisWorkbook.Path & "\Nome File Anno "

    'Application.ScreenUpdating = False

    With sh

        If .Range("H2").Value = "" Then

             MsgBox "Nessun anno selezionato."

            Exit Sub

        End If

        sNomeFile = sPath & Year(Sheets("Anni").Range("D1").Value) & ".xls"

       If Dir(sNomeFile) <> "" Then

            lRisposta = _

                MsgBox(Prompt:="Il file: " & sNomeFile & " esiste già. Sovrascriverlo?.", _

                Title:="Attenzione", _

                Buttons:=vbYesNo + vbQuestion)

            If lRisposta = vbNo Then Exit Sub

       End If

        Application.CutCopyMode = False

        Sheets(.Name).Copy

        Workbooks(ActiveWorkbook.Name).SaveAs Filename:=sNomeFile, FileFormat:=xlExcel8 '<in errore        ActiveWorkbook.Close

    End With

    Application.ScreenUpdating = True

    Set sh = Nothing

Sheets("CopiaAnno").Visible = False

'<---Alla fine nascondo nuovamente il foglio di appoggio "CopiaAnno"

End Sub

Il problema mi si crea con un doppio messaggio di avviso in caso di file già esistente, il primo avviso, credo quello impostato da Mauro nella macro, funziona regolarmente, il secondo, credo quello di default di Office se premo "SI" per sovrascivere, va bene, se premo "NO" oppure "ANNULLA" mi va in errore sulla riga segnalata:

"Workbooks(ActiveWorkbook.Name).SaveAs Filename:=sNomeFile, FileFormat:=xlExcel8 '<in errore"

Ho provato anche  a levare la parte di codice:

       If Dir(sNomeFile) <> "" Then

            lRisposta = _

                MsgBox(Prompt:="Il file: " & sNomeFile & " esiste già. Sovrascriverlo?.", _

                Title:="Attenzione", _

                Buttons:=vbYesNo + vbQuestion)

            If lRisposta = vbNo Then Exit Sub

       End If

per avere direttamente un solo avviso, ma rimane i problema che va in errore se decido di annullare o non sovrascrivere, quindi non premo "SI".

Spero si possa risolvere e di non aver incasinato troppo il codice. Vi ringrazio e auguro una buona giornata a tutti.

Ciao

Antonio

Answer 1

Scusate apro un altro trend per un problema che mi si è presentato con una macro che gentilmente mi aveva passato Mauro (che saluto), la discussione era questa:

http://social.answers.microsoft.com/Forums/it-IT/officeexcelit/thread/381cd49a-cdbd-4f31-9540-54262ac17fdc

Ho tentato di adattare la macro alle mie esigenze, questo il risultato:

<cut>

Il problema mi si crea con un doppio messaggio di avviso in caso di file già esistente, il primo avviso, credo quello impostato da Mauro nella macro, funziona regolarmente, il secondo, credo quello di default di Office se premo "SI" per sovrascivere, va bene, se premo "NO" oppure "ANNULLA" mi va in errore sulla riga segnalata:

<cut>

per avere direttamente un solo avviso, ma rimane i problema che va in errore se decido di annullare o non sovrascrivere, quindi non premo "SI".

Spero si possa risolvere e di non aver incasinato troppo il codice. Vi ringrazio e auguro una buona giornata a tutti.

 

Aggiungi: Application.DisplayAlerts = False sotto a Application.ScreenUpdating = False e Application.DisplayAlerts=True sotto a Application.ScreenUpdating = True. Dovrebbe funzionare. Fai sapere, grazie.

---

--

La soluzione, il codice ed i files sono forniti *così come sono* e l’autore declina ogni responsabilità per eventuali problemi causati dalla soluzione proposta se usata impropriamente. Create e utilizzate una copia del file per le vostre prove, *prima* di utilizzare la soluzione in files importanti.

--

Mauro Gamberini - Microsoft© MVP(Excel)

http://www.maurogsc.eu/

Answer 2

Perfetto Mauro, grazie infinite, bravo oltre che veloce. Ora funziona tutto; auguro a te e a tutto il forum una buona giornata.

Ciao

Antonio

Bene. Grazie per il cortese riscontro e buon lavoro.

---

--

La soluzione, il codice ed i files sono forniti *così come sono* e l’autore declina ogni responsabilità per eventuali problemi causati dalla soluzione proposta se usata impropriamente. Create e utilizzate una copia del file per le vostre prove, *prima* di utilizzare la soluzione in files importanti.

--

Mauro Gamberini - Microsoft© MVP(Excel)

http://www.maurogsc.eu/

Answer 3

Perfetto Mauro, grazie infinite, bravo oltre che veloce. Ora funziona tutto; auguro a te e a tutto il forum una buona giornata.

Ciao

Antonio