Supprimer Macros Résolu/Fermé

Question

Bonjour, 

Je viens de finir une macro permettant l'enregistrement d'onglets dans de nouveaux fichiers (merci à f894009). Maintenant, j'aimerai pouvoir enlever dans ces nouveaux fichiers, les macros inclues.

J'ai parcouru les Forums, j'avoue ne pas y trouver mes petits.

Merci à vous par avance.

Benoit


Configuration: Windows / Firefox 53.0

jordane45 · Answer

Bonjour,

Si tu souhaites surpprimer des macros (des procédures) de tes onglets (les feuilles) tu peux utiliser une macro du genre

Sub Supprimer_Code_Feuilles()

Dim NomFeuille As String
 
NomFeuille = "Feuil1"
 
With ActiveWorkbook.VBProject.VBComponents _
(ActiveWorkbook.Sheets(NomFeuille).CodeName).CodeModule
    .DeleteLines 1, .CountOfLines
    .CodePane.Window.Close
End With
 


Le tout pouvant être placé dans un for each pour boucler sur les différentes feuilles du classeur directement...
un truc du genre

Dim wkb As Workbook

Set wkb = Workbook("nom_du_classeur")

For Each sh In wkb.Sheets
With ActiveWorkbook.VBProject.VBComponents _
(sh.CodeName).CodeModule
    .DeleteLines 1, .CountOfLines
    .CodePane.Window.Close
End With

Next



D'autres macros utiles de suppression :
https://www.developpez.net/forums/d569894/logiciels/microsoft-office/general-vba/supprimer-macros-macro/

.

Benoit_Lyon · Answer

Bonjour Jordane

Merci pour ce bout de code. Malheureusement, je pense qu'il me manque encore un peu de pratique. 
Ci-dessous votre code que j'ai essayé d'intégrer à mon code. 

Option Explicit
Sub Création_Fichiers()
    ' Export Fichier
    Dim memPath As String   'Mémorise l'emplacement du fichier ouvert
    Dim Path As String      'Défini la variable Path
    Dim nom As String
    Dim nom_1 As String       'Défini la variable nom
    Dim nom_2 As String
    Dim nom_3 As String
    Dim NomFeuille1 As String
    Dim NomFeuille2 As String
    Dim NomFeuille3 As String
    
    ActiveWorkbook.Save                  'sauvegarde le classeur en cours
    memPath = ThisWorkbook.FullName      'Mémorise l'emplacement du fichier
    Application.DisplayAlerts = False 'Enlève les messages d'alertes Excel
    Application.ScreenUpdating = False
        
    Path = ActiveWorkbook.Path & "\"
    nom_1 = "Mon fichier 1" & ".xlsm"     'Enregistre le fichier
    nom_2 = "Mon fichier 2" & ".xlsm"
    nom_3 = "Mon fichier 3" & ".xlsm"
    NomFeuille1 = "Liste Triable 1"
    NomFeuille2 = "Liste Triable 2"
    NomFeuille3 = "Liste Triable 3"
    
    ActiveWorkbook.SaveAs Filename:=Path & nom_1  'Enregistre le fichier dans le dossier d'origine
    ActiveWorkbook.SaveAs Filename:=Path & nom_2
    ActiveWorkbook.SaveAs Filename:=Path & nom_3
    
    Workbooks.Open Filename:=Path & nom_1
    With Workbooks(nom_1)
        .Sheets(Array("Liste Complete", "Cachée Tri", "Liste Triable 2", "Liste Triable 3")).Delete 'Supprime les onglets non pertinents
    End With
  
  With ActiveWorkbook.VBProject.VBComponents _
  (ActiveWorkbook.Sheets(NomFeuille1).CodeName).CodeModule
    .DeleteLines 1, .CountOfLines
    .CodePane.Window.Close
    End With
    
  Workbooks(nom_1).Close True
  
    Workbooks.Open Filename:=Path & nom_2
    With Workbooks(nom_2)
        .Sheets(Array("Liste Complete", "Cachée Tri", "Liste Triable 1", "Liste Triable 3")).Delete 'Supprime les onglets non pertinents
        .Close True
    End With
    
    'le classeur actif n'est plus celui d'origine mais: nom_3
    With ActiveWorkbook
        .Sheets(Array("Liste Complete", "Cachée Tri", "Liste Triable 2", "Liste Triable 1")).Delete 'Supprime les onglets non pertinents
        .Save
    End With
     
    Application.DisplayAlerts = True 'Remet les alertes Excel
    Application.ScreenUpdating = True
         
    Application.Workbooks.Open memPath  'Réouvre l'emplacement du fichier qui a été mémorisé
    Workbooks(nom_3).Close False            'Fermer ce classeur (la copie)
End Sub

J'ai un message qui apparait "L'accès par programme au projet VBa n'est pas fiable".

Merci pour votre aide.
Benoit

f894009 · Answer

Bonjour,

Ben, fallait copier chaque onglet desire dans un nouveau fichier, pas enregistrer le fichier sous trois noms differents en xlsm

Sub Creation_Fichier_1()
    ' Export Fichier
    Dim memPath As String   'Mémorise l'emplacement du fichier ouvert
    Dim Path As String      'Défini la variable Path
    Dim n As Long
    Dim TNom As Variant
    Dim TOnglet As Variant

ActiveWorkbook.Save                  'sauvegarde le classeur en cours
    memPath = ThisWorkbook.FullName      'Mémorise l'emplacement du fichier
    Application.DisplayAlerts = False 'Enlève les messages d'alertes Excel
    Application.ScreenUpdating = False
        
    Path = ActiveWorkbook.Path & "\"
    TNom = Array("Mon fichier 1.xlsx", "Mon fichier 2.xlsx", "Mon fichier 3.xlsx")    'Enregistre le fichier
    TOnglet = Array("Liste Triable 1", "Liste Triable 2", "Liste Triable 3")
    
    For n = 0 To 2
        Sheets(TOnglet(n)).Copy
        With ActiveWorkbook
            .SaveAs Filename:=Path & TNom(n), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            .Close
        End With
    Next n
    Application.DisplayAlerts = True 'Enlève les messages d'alertes Excel
    Application.ScreenUpdating = True
End Sub

Supprimer Macros

3 réponses

Discussions similaires