Beug avec ActiveWorkbook.Save dans un module

Edit :
Le texte en italique n'est pas correct, car si le classeur "Copie du planning.xlsx" est ouvert le classeur "Chevalley.xlsm" n'est pas enregistré.

Pierre,
Je tiens à te remercier pour toutes les infos transmises et surtout le temps passé et la patience à aider un inconnu. Mille merci.
Ce forum est génial et la qualité des infos au top

Au début de cette discussion je pensais vite ajouter un bouton sur la feuillle pour effectuer excatement toutes les macros contenues dans Workbook_BeforeSave

Merci
Philippe

Pierre,

Lorsque le classeur "Copie du planning.xlsx" est ouvert la macro plante et c'est normal.
Avec mon ancien code, je commençais par vérifier avec la Sub Copie_fichier_xlsx() si le classeur "Copie du planning.xlsx" existe, si il n'existe pas, on le créer, puis si il est ouvert on informe que la copie du planning est ouverte et que la mise à jour du classeur "Copie du planning.xlsx" est impossible.

J'ai affecté cette macro au bouton se trouvant sur la feuille Intervention du classeur "Chevalley.xlsm" et tout se passe correctement lorsque le Classeur n'existe pas ou qu'il est ouvert.

En revanche avec Workbook_BeforeSave on lance la macro via CreateCopy et là forcement ça plante lorsque le classeur "Copie du planning.xlsx" est ouvert.

Y a-t-il une autre manière de vérifier si le classeur "Copie du planning.xlsx" est ouvert ?

Merci
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 Option Compare Text 'Pour évietre les problème de minus ou majuscule dans les noms des variantes "AAA" is equal to "aaa". Option Explicit Dim chemin As String Dim Nom_du_xlsx As String Sub Copie_fichier_xlsx() 'Dans Workbook_BeforeSave Dim Verification As Boolean Dim MonClasseur As String chemin = ThisWorkbook.Path & "\" Nom_du_xlsx = "Copie du planning.xlsx" 'Mise à jour de la copie avec la Function EstClasseurOuvert(MonClasseur As String) MonClasseur = chemin & Nom_du_xlsx 'Vérifier si la copie existe If Len(Dir(MonClasseur)) = 0 Then 'Si la copie n'existe pas, créer la copie Copie_xlsx.CreateCopy Else 'Si la copie existe, vérifier si la copie est ouverte Verification = EstClasseurOuvert(MonClasseur) If Verification = True Then 'Si la copie est ouverte on informe et on quitte. MsgBox "La copie du planning est ouverte, mise à jour impossible...", vbInformation, "Info" Exit Sub Else 'Si la copie est fermée Copie_xlsx.CreateCopy End If End If End Sub Sub CreateCopy(Optional CalledBySave As Boolean) Dim Target As Workbook On Error GoTo Catch Application.ScreenUpdating = False 'Copier les feuilles Sheets(Array("Interventions", "DATA_Jours_Fériés")).Copy Set Target = ActiveWorkbook 'Renommer la feuille ThisWorkbook.Activate Target.Worksheets("Interventions").Name = "Planning" 'Actions sur le nouveau classeur With Target.Worksheets("Planning") .Range("S1") = Now & " dernière mise à jour de cette copie du planning." 'Indiquer la date de mise à jour dans le planning .DrawingObjects.Delete 'Supprimer toutes les images End With Target.Worksheets("DATA_Jours_Fériés").DrawingObjects.Delete 'Supprimer toutes les images 'Enregister le fichier Application.DisplayAlerts = False Target.SaveAs Filename:=chemin & Nom_du_xlsx, FileFormat:=xlOpenXMLWorkbook 'FileFormat:=XlFileFormat.xlOpenXMLWorkbookMacroEnabled Target.Close False Application.DisplayAlerts = True If Not CalledBySave Then ThisWorkbook.Save Catch: ' If Err <> 0 Then MsgBox "L'erreur suivante est survenue:" & vbLf & Err.Description, vbExclamation, "Erreur " & Err.Number Application.ScreenUpdating = True End Sub