Comment gérer les erreurs à l'enregistrement sous ?

[OngNoi]

Bonjour à tous,

Je voudrais que la macro demande à l'utilisateur de donner le nom du fichier à Enregistrer. Si ce nom existe déjà il faut que l'utilisateur entre un autre nom et ainsi de suite...., boucle jusqu'à ce que le nom donné n'existe pas encore dans le répertoire.
Voici ma macro (qui ne marche pas):

Dim Nom As String
MsgBox "Le fichier sera archivé dans le répertoire C:\Estimations"
On Error Resume Next
MkDir "c:\Estimations"
Workbooks.Add

Nom = InputBox("Veuillez entrer le nom du fichier à archiver")
On Error GoTo Etiquette1
ActiveWorkbook.SaveAs Filename:="C:\Estimations\" & Nom & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

Exit Sub

Etiquette1:
Nom = InputBox("1. Veuillez entrer un aute nom pour archiver")
On Error GoTo Etiquette2 'cette instruction ne marche pas, elle refuse d'aller à Etiquette2'

ActiveWorkbook.SaveAs Filename:="C:\Estimations\" & Nom & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Exit Sub

Etiquette2:
Nom = InputBox("2. Veuillez entrer un aute nom pour archiver")
On Error GoTo Etiquette3
ActiveWorkbook.SaveAs Filename:="C:\Estimations\" & Nom & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Exit Sub
Etiquette3:
msgbox "Entrez un nom qui n'existe pas"
ActiveWorkbook.SaveAs Filename:="C:\Estimations\" & Nom & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

ActiveWorkbook.Close

End Sub


MERCI PAR AVANCE

 

[Gael]

Re : Comment gérer les erreurs à l'enregistrement sous ?

Bonjour Ongnoi,

Pourquoi ne pas afficher la boite de dialogue enregistrer sous et l'utilisateur va choisir le nom du fichier ou annuler pour ne pas sauvegarder:

Sub Testsave()
Dim Nom As Variant
Nom = Application.GetSaveAsFilename("C:\Estimations\" & ThisWorkbook.Name, _
filefilter:="Classeur Microsoft Excel (*.xls),*.xls")
If Nom = False Then Exit Sub
ThisWorkbook.SaveAs Filename:=Nom
End Sub

Si le répertoire C:\estimations n'existe pas, le système proposera le répertoire par défaut défini dans les options d'Excel.

Sinon, tu peux gérer en amont la création du répertoire Estimations si nécessaire.

@+

Gael

 

[OngNoi]

Re : Comment gérer les erreurs à l'enregistrement sous ?

Merci Gael de t'être penchée sur mon problème.
J'ai intégré ton code dans la macro suivante:

Dim Nom As Variant
MsgBox "Le fichier sera archivé dans le répertoire C:\Estimations"
On Error Resume Next
MkDir "c:\Estimations"
Workbooks.Add

Nom = Application.GetSaveAsFilename("C:\Estimations\" & ThisWorkbook.Name, _
filefilter:="Classeur Microsoft Excel (*.xls),*.xls")
If Nom = False Then Exit Sub
ThisWorkbook.SaveAs Filename:=Nom

Mais il ne veut pas Enregistrer le nouveau Classeur de Workbook.Add, il enregistre systématiquement la feuille qui contient la macro !

Par ailleurs, peux-tu m'expliquer pourquoi dans ma macro initiale, l'instruction "Goto Etiquette2 " n'envoyait pas vers Etiquette2 ?

Merci beaucoup

 

[Gael]

Re : Comment gérer les erreurs à l'enregistrement sous ?

Bonjour OngNoi,

Pour qu'il enregistre le nouveau classeur, il suffit d'utiliser "Activeworkbook" au lieu de "ThisWorkbook". Tu peux mettre un nom par défaut que l'utilisateur acceptera ou modifiera dans la boîte de dialogue avant d'enregistrer:

Sub Testsave()
Dim Nom As Variant
MsgBox "Le fichier sera archivé dans le répertoire C:\Estimations"
On Error Resume Next
MkDir "c:\Estimations"
Workbooks.Add
Nom = Application.GetSaveAsFilename("C:\Estimations\" & "Nom par défaut", _
filefilter:="Classeur Microsoft Excel (*.xls),*.xls")
If Nom = False Then Exit Sub
ActiveWorkbook.SaveAs Filename:=Nom
End Sub

Pour le "Goto Etiquette2", je pense que dans ce cas le gestionnaire d'erreur est déjà actif et qu'il ne peut s'activer une deuxième fois, Etiquette2 est une erreur à l'intérieur de l'erreur Etiquette1. Ceci étant, je ne suis pas sufisamment expert en VBA et ma réponse reste incertaine sur ce point.

@+

Gael

 

[OngNoi]

Re : Comment gérer les erreurs à l'enregistrement sous ?

Bonjour Gael,

1) Je retiens ton idée très intéressante d'afficher la boite de dialogue permettant ainsi à l'utilisatereur de voir tous les fichiers existants.
2) Avec ta suggestion, à vrai dire il n'y a plus de problème de gestion d'erreurs. Mais j'ai quand même étudié mon "bug" et trouvé pourquoi le "On Error Goto..." ne marchait pas. Comme tu l'as pressenti, il ne peut y avoir 2 On Error dans le même SUB. Il faut faire un CALL et un autre SUB pour réinitialiser le On Error...
3) J'ai voulu donner à l'utilisateur le droit à l'échec 3 fois, c'est pourquoi j'ai combiné les 2 codes. Voici le résultat:

Dim Nom1 As Variant
Dim ClasseurVide As String
Dim Nom As String
MsgBox "Le fichier sera archivé dans le répertoire C:\Estimations"
On Error Resume Next
MkDir "C:\Estimations"

Workbooks.Add

Nom1 = Application.GetSaveAsFilename("C:\Estimations\" & ClasseurVide, _
filefilter:="Classeur Microsoft Excel (*.xls),*.xls")
On Error GoTo Etiquette0
ActiveWorkbook.SaveAs Filename:=Nom
ActiveWorkbook.Close
Exit Sub

Etiquette0:
Call ROUTINE0
End Sub

Sub ROUTINE0()

Nom = InputBox("1. Le nom que vous avez choisi existe déjà dans le répertoire C:\Estimations. Veuillez entrer un nouveau nom de fichier")
On Error GoTo Etiquette1
ActiveWorkbook.SaveAs Filename:="C:\Estimations\" & Nom & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
Exit Sub

Etiquette1:
Call ROUTINE1
End Sub


Sub ROUTINE1()

Nom = InputBox("2. Veuillez entrer un aute nom pour archiver")
On Error GoTo Etiquette2
ActiveWorkbook.SaveAs Filename:="C:\Estimations\" & Nom & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
Exit Sub
Etiquette2:
Call ROUTINE2
End Sub

Sub ROUTINE2()
Nom = InputBox("3. Veuillez entrer un aute nom pour archiver")
On Error Resume Next
ActiveWorkbook.SaveAs Filename:="C:\Estimations\" & Nom & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
Exit Sub

End Sub


ENCORE MERCI GAEL

 

[Gael]

Re : Comment gérer les erreurs à l'enregistrement sous ?

Bonsoir Ongnoi,

Je te propose une autre variante, qui ne gère cependant pas le fait d'écraser volontairement un fichier existant en répondant "Oui" au message d'info. Ceci étant ta macro ne l'interdit pas non plus. Par contre, les différents types d'erreurs sont bien gérés et j'ai fait une boucle plus pratique que plusieurs sous-routines.

Sub Testsave()
Dim Nom As Variant, Retry As Integer
Dim ClasseurVide As String, Titre As String
MsgBox "Le fichier sera archivé dans le répertoire C:\Estimations"
On Error Resume Next
MkDir "C:\Estimations"
Workbooks.Add
Do While Retry < 3
Retry = Retry + 1
    Select Case Retry
        Case 1:
            Titre = "Premier essai"
        Case 2:
            Titre = "Deuxième essai"
        Case 3:
            Titre = "Troisième essai"
    End Select
Nom = Application.GetSaveAsFilename("C:\Estimations\" & ClasseurVide, _
filefilter:="Classeur Microsoft Excel (*.xls),*.xls", Title:="Archivage nouveau dossier : " & Titre)
If Nom <> False Then
ActiveWorkbook.SaveAs Filename:=Nom, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End If
    If Err.Number = 0 And Nom <> False Then
    MsgBox "Fichier archivé : " & Nom
    Exit Do
    Else
    Err.Clear
    If Retry = 3 Then MsgBox "Votre fichier n'a pas été archivé"
    End If
Loop
ActiveWorkbook.Close
End Sub

En résumé:
* Pas interdit d'écraser un fichier existant
* Si aucune sauvegarde n'est effectuée, le fichier est fermé quand même

Dis-moi ce que tu en penses.

@+

Gael

Edit: Finalement, tu peux remplacer le Do...loop par un For...Next (sans oublier de remplacer Exit do par exit for) cela économise l'instruction Retry=Retry+1 que l'on peut supprimer.

 

[OngNoi]

Re : Comment gérer les erreurs à l'enregistrement sous ?

Bonjour Gael,

C'est tout bonnement génial et beaucoup plus "élégant" que mes Etiquettes et Routines.
J'ai aussi remplacé le DO...LOOP par un FOR...NEXT. Tout est ok. Ma macro est finalisée.

J'ai acquis des connaissances précieuses.

MERCI

Ongnoi

PS: Je ne veux pas que l'utilisateur "voit" mon code et le modifie. Comment je peux faire ?

 

[Gael]

Re : Comment gérer les erreurs à l'enregistrement sous ?

Bonjour Ongnoi,

Pour protéger le code, tu fais un clic droit sur le module puis "Propriétés VBAproject" et onglet protection.

J'aurai aussi supprimé le premier message qui indique que la sauvegarde sera effectuée dans le répertoire C:\Estimations puisque la boîte de dialogue se positionne directement dessus.

@+

Gael

 

[Gael]

Re : Comment gérer les erreurs à l'enregistrement sous ?

Bonjour Ongnoi,

Finalement, comme ton idée de départ était de ne pas écraser un fichier déjà existant, j'ai fait une autre procédure similaire à la précédente mais avec un test si le fichier existe déjà et dans ce cas on passe à l'essai suivant. En même temps, je propose un nom par défaut pour la sauvegarde.

Avec ces 2 procédures, je pense que tu pourras en faire une troisième qui répondra exactement à ta demande!

Sub Testsave()
Dim Nom As Variant, fs As Variant, Retry As Integer
Dim Nomdef As String, Titre As String
On Error Resume Next
MkDir "C:\Estimations"
Set fs = CreateObject("Scripting.FileSystemObject")
Workbooks.Add
Nomdef = "EstimBKP_" & Format(Date, "yyyymmdd")
For Retry = 1 To 3
    Select Case Retry
        Case 1:
            Titre = "Premier essai"
        Case 2:
            Titre = "Deuxième essai"
        Case 3:
            Titre = "Troisième essai"
    End Select
Nom = Application.GetSaveAsFilename("C:\Estimations\" & Nomdef, _
filefilter:="Classeur Microsoft Excel (*.xls),*.xls", Title:="Archivage nouveau dossier : " & Titre)
If Nom <> False And Not fs.FileExists(Nom) Then
    ActiveWorkbook.SaveAs Filename:=Nom
    Exit For
    ElseIf Nom <> False Then
        MsgBox ("Nom de fichier déjà existant")
End If
Next Retry
    If Retry > 3 Then
        If Nom = False Or fs.FileExists(Nom) Then
        MsgBox ("Fichier non sauvegardé")
        End If
    End If
ActiveWorkbook.Close
End Sub

@+

Gael

 

[OngNoi]

Re : Comment gérer les erreurs à l'enregistrement sous ?

Bonsoir Gael,

J'ai déjà figé ma macro sur la version du 30/08, mais je trouve ta syntaxe du 1/9 très intéressante aussi. Je ne suis pas familier du Set fs = CreateObject...

Pour revenir à ma macro, j'ai dû introduire un Err.Clear avant le premier test If Nom <> False sinon ça ne marche pas bien quand l'utilisateur entre du 1er coup un nom qui n'existe pas.

A+