Modification Macro

Application.DisplayAlerts = False 'on désactive les messages d'alerte pour éviter d'avoir à confirmer la sauvegarde au format xlsx qui ne contient plus les macros
'on enregistre sous le nom constitué du chemin complet et nomfichier + extension .xlsx pour supprimer les macro
ActiveWorkbook.SaveAs Filename:=CheminCompletNomFichier & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

'*************************************************************************************
'supprimer dans la nouvelle feuille les boutons
For Each sh In ActiveSheet.Shapes 'Boutons qui portent un nom contenant BT
    If sh.Name Like "BT*" Then sh.Delete
Next sh
'**************************************************

ActiveWorkbook.Close savechanges:=True 'on ferme la demande
Application.DisplayAlerts = True 'on REACTIVE les messages d'alerte
[code]

Sub Supprimer_Macro_Precise()
Dim Debut As Integer, Lignes As Integer
Dim NomMod As String, NomMacro As String

NomMod = "Module3"
NomMacro = "Macro1"

With ThisWorkbook.VBProject.VBComponents(NomMod).CodeModule
    Debut = .ProcStartLine(NomMacro, 0)
    Lignes = .ProcCountLines(NomMacro, 0)
    .DeleteLines Debut, Lignes
End With

End Sub

Sub Supprimer_Macro_Precise()
Dim Debut As Integer, Lignes As Integer
Dim NomMod As String, NomMacro As String

NomMod = "Module3"
NomMacro = "Macro1"
set Wb=workbooks("NOMNOUVEAUCLASSEUR.xls")

With Wb.VBProject.VBComponents(NomMod).CodeModule
    Debut = .ProcStartLine(NomMacro, 0)
    Lignes = .ProcCountLines(NomMacro, 0)
    .DeleteLines Debut, Lignes
End With

End Sub

Sub EnregistrerSous()
    Dim nWb$, chDos$
    nWb = ActiveSheet.Range("C6") & ".xlsm"
    chDos = "C:\Users\oem\Desktop\DEVIS\"
    ThisWorkbook.SaveCopyAs chDos & nWb
    With Workbooks.Open(chDos & nWb)
   With .VBProject.VBComponents
            .Remove .Item("Module2")
        End With
        .Worksheets("Devis").Shapes("Rectangle 1").Delete
        .Close True
    End With
    Application.Quit
End Sub

With VBProject.VBComponents