Sub memorise()
'recopie la feuille res vers une couvelle feuille en supprimant les liaisons
Dim NomFeuil
Dim DrObj As DrawingObjects
Dim Graph As ChartObject, I As Integer
'création et nommage de la feuille de destination (test pour vérifier qu'elle n'existe pas déjà
NomFeuil = Application.InputBox("Entrez un nom (court!) pour l'hypothèse à enregistrer", "Nom de l'hypothèse")
On Error Resume Next
Worksheets(NomFeuil).Select
If Err <> 0 Then
Sheets.Add.Name = NomFeuil
Else
MsgBox ("Ce nom existe déjà, donnez en un autre")
Exit Sub
End If
Sheets(NomFeuil).Range("w1").Value = "Hypothèse : " & NomFeuil
Sheets("hypothèses").Activate
Cells.Copy
Sheets(NomFeuil).Paste
Application.CutCopyMode = False
Sheets(NomFeuil).Activate
Set DrObj = ActiveSheet.DrawingObjects
I = DrObj.Count + 1
Application.ScreenUpdating = False
For Each Graph In ActiveSheet.ChartObjects
Graph.CopyPicture
ActiveSheet.Paste
With DrObj.Item(I)
.Left = Graph.Left
.Top = Graph.Top
End With
Graph.Delete
Next Graph
ActiveWindow.RangeSelection.Select
Cells.Copy
Cells.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub