excel_lence
XLDnaute Nouveau
salut t le monde,
je voudrai modifier le code ci dessous.
ce code me permet de faire des sauvegarde en XLSM et XLS en meme temps avec le meme nom de fichier et le meme emplacement ( adresse) ,le tout automatiquement.
le hic est que des fois, pour diverses raisons, j'ai pas envie de sauvegarder, il le fait quant meme malgré que dans la boite de dialogue je clique sur "non" il sauvegarde quand meme le deux fichier ( XLS & XLSM ).
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim n%, chemin$, fichier$
If Val(Application.Version) < 12 Or Right(Me.Name, 4) = ".xls" Then Exit Sub
Me.Save 'sauvegarde
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier .xls existe déjà
With Application
n = .SheetsInNewWorkbook
.SheetsInNewWorkbook = Me.Worksheets.Count
Workbooks.Add 'nouveau document
.SheetsInNewWorkbook = n
End With
With ActiveWorkbook
For n = 1 To .Worksheets.Count
With .Worksheets(n)
Me.Worksheets(n).Cells.Copy .Cells
.UsedRange = .UsedRange.Value
.Name = Me.Worksheets(n).Name
End With
Next
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = Left(Me.Name, Len(Me.Name) - 5) & ".xls"
.SaveAs chemin & fichier, 56
.Close
End With
End Sub
je voudrai modifier le code ci dessous.
ce code me permet de faire des sauvegarde en XLSM et XLS en meme temps avec le meme nom de fichier et le meme emplacement ( adresse) ,le tout automatiquement.
le hic est que des fois, pour diverses raisons, j'ai pas envie de sauvegarder, il le fait quant meme malgré que dans la boite de dialogue je clique sur "non" il sauvegarde quand meme le deux fichier ( XLS & XLSM ).
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim n%, chemin$, fichier$
If Val(Application.Version) < 12 Or Right(Me.Name, 4) = ".xls" Then Exit Sub
Me.Save 'sauvegarde
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier .xls existe déjà
With Application
n = .SheetsInNewWorkbook
.SheetsInNewWorkbook = Me.Worksheets.Count
Workbooks.Add 'nouveau document
.SheetsInNewWorkbook = n
End With
With ActiveWorkbook
For n = 1 To .Worksheets.Count
With .Worksheets(n)
Me.Worksheets(n).Cells.Copy .Cells
.UsedRange = .UsedRange.Value
.Name = Me.Worksheets(n).Name
End With
Next
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = Left(Me.Name, Len(Me.Name) - 5) & ".xls"
.SaveAs chemin & fichier, 56
.Close
End With
End Sub
Dernière édition: