sauvegarde sur autre classeur avant fermeture [RESOLU]

[mistick]

Bonjour à tous,

J'ai créé une macro qui permet à l'utilisateur de chosir s'il souhaite enregistrer sa simulation dans un autre classeur avant de quitter. Dans le cas contraire, il quitte le classeur sans enregistrer.
ça remplace le message traditionnel de fermeture d'excel, car je ne veux pas que l'utilisateur puisse sauvegarder sur l'original (je l'ai également placé en lecture seule, mais on ne sait jamais^^).

ça donne :

 Private Sub Workbook_BeforeClose(Cancel As Boolean)
 Select Case MsgBox("Voulez-vous sauvegarder cette simulation dans un nouveau classeur?", vbQuestion + vbYesNoCancel, "Fermeture du simulateur")
Case vbYes
export_classeur1 'renvoie à la procédure qui copie la feuille dans un nouveau classeur
ThisWorkbook.Close savechanges:=False 'devrait entrainer la fermeture du classeur sans enregistrer

Case vbNo
ThisWorkbook.Saved = True
Case vbCancel
Cancel = True

Exit Sub
End Select

ça marche plutôt bien, mais le souci que j'ai avec ça c'est que si je clique sur oui, il ouvre le nouveau classeur, copie la feuille, mais au lieu de fermer le premier classeur, il me renvoie la msgbox une seconde fois (quand je clique sur oui la seconde fois, le classeur se ferme comme il faut, et ne reste ouvert que le nouveau classeur où s'est effectuée la copie = ce que je veux quoi^^).

Quelqu'un saurait-il d'où provient ce petit (mais agaçant) bug?

 

[Pierrot93]

Re : sauvegarde sur autre classeur avant fermeture

Bonjour,

peut être nous montrer la procédure d'export "export_classeur1"...

bon après midi
@+

 

[mikachu]

Re : sauvegarde sur autre classeur avant fermeture

a défaut de procédure, j'ai bidouillé à partir d'autres sujets de ce forum..

colle ça dans thisworkbook (à la place de ta macro)

Dim savedas As Boolean




Private Sub Workbook_BeforeClose(Cancel As Boolean)

If savedas = 0 Then
Select Case MsgBox("Voulez-vous sauvegarder cette simulation dans un nouveau classeur?", vbQuestion + vbYesNoCancel, "Fermeture du simulateur")
Case vbYes
savedas = 1
EnregistrerSous:
FichierEnregistrerSous = Application.GetSaveAsFilename(NomEtChemin, fileFilter:="Fichiers Microsoft Excel (*.xls), *.xls")
If FichierEnregistrerSous <> False Then
Affichage = MsgBox("Vous allez enregistrer " & NomFichier & " sous :" & Chr(10) & Chr(10) & FichierEnregistrerSous, , "Enregistrement du fichier")
Else
GoTo LaFin
End If

If Dir(FichierEnregistrerSous) <> "" Then
Affichage = MsgBox("Un fichier du même nom existe déjà à cet emplacement." & _
Chr(10) & Chr(10) & "Renommez le ou supprimer le.", vbExclamation, "NDLR")
GoTo EnregistrerSous
End If

ActiveWorkbook.SaveAs Filename:=FichierEnregistrerSous, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=True

LaFin:
ThisWorkbook.Close savechanges:=False 'devrait entrainer la fermeture du classeur sans enregistrer

Case vbNo
ThisWorkbook.Saved = True
Case vbCancel
Cancel = True

Exit Sub
End Select
End If

End Sub

Si ça semble bordélique c'est que ça l'est. je me suis contenté de modifier des macros trouvé ici pour répondre à tes besoin
Le principal c'est que ça semble marcher.

mikachu

 

[mistick]

Re : sauvegarde sur autre classeur avant fermeture

Bonjour Pierrot, Mikachu, et merci de vous pencher sur mon problème!

Mikachu, ta procédure ne correspond pas à mon besoin parce que je ne souhaite enregistrer qu'une feuille de mon classeur (la feuille test Ktype), et de plus, sans les boutons liés aux macros. En plus je ne veux pas définir le répertoire d'enregistrement, cas les utilisateurs devront enregistrer leurs résultats dans des répertoires différents les uns des autres...

La procédure que j'appelle c'est :

Public Sub export_classeur1()
' exporter la feuille test Ktype vers un nouveau classeur, sans les boutons, en conservant l'originale

     Sheets("test Ktype").Select
    Sheets("test Ktype").Copy
    ActiveSheet.Shapes("CommandButton_choixKtype").Delete
    ActiveSheet.Shapes("actualiser").Delete
    ActiveSheet.Shapes("comparateur1").Delete
    ActiveSheet.Shapes("comparateur2").Delete
    ActiveSheet.Shapes("Bouton_exporter").Delete

   
End Sub

très simpliste j'avoue, mais efficace en temps normal (elle est également liée au bouton exporter). ça ouvre un nouveau classeur et colle dedans directement ma feuille...

 

[Pierrot93]

Re : sauvegarde sur autre classeur avant fermeture

Re,

modifie come suit :

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Select Case MsgBox("Voulez-vous sauvegarder cette simulation dans un nouveau classeur?", vbQuestion + vbYesNoCancel, "Fermeture du simulateur")
Case vbYes
export_classeur1 'renvoie à la procédure qui copie la feuille dans un nouveau classeur
Application.EnableEvents = False
ThisWorkbook.Close savechanges:=False 'devrait entrainer la fermeture du classeur sans enregistrer
Application.EnableEvents = True
Case vbNo
ThisWorkbook.Saved = True
Case vbCancel
Cancel = True
End Select
End Sub

 

[Pierrot93]

Re : sauvegarde sur autre classeur avant fermeture

Re,

essaye plutôt avec ceci :

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Static b As Boolean
If b Then Exit Sub
Select Case MsgBox("Voulez-vous sauvegarder cette simulation dans un nouveau classeur?", vbQuestion + vbYesNoCancel, "Fermeture du simulateur")
Case vbYes
export_classeur1 'renvoie à la procédure qui copie la feuille dans un nouveau classeur
b = True
ThisWorkbook.Close savechanges:=False 'devrait entrainer la fermeture du classeur sans enregistrer
b = False
Case vbNo
ThisWorkbook.Saved = True
Case vbCancel
Cancel = True
End Select
End Sub

attention si tu as déjà exécuté le code précedent les événementielles ont été désactivées... pour les réactiver, execute l'instruction suivante ou relance Excel :

Application.EnableEvents = True

 

[mistick]

Re : sauvegarde sur autre classeur avant fermeture

Merci beaucoup Pierrot, je testerai ça lundi à la première heure et te dirai ce qu'il en est. (j'ai quitté le boulot en laissant la dernière version là bas...)

Bon weekend!

 

[mistick]

Re : sauvegarde sur autre classeur avant fermeture

Testé ce matin, marche parfaitement bien!! Merci beaucoup Pierrot, c'est parfait =)