Supprimer Macros [Résolu]

Benoit_Lyon 92 Messages postés vendredi 20 janvier 2017Date d'inscription 12 décembre 2017 Dernière intervention - 15 mai 2017 à 10:27 - Dernière réponse : Benoit_Lyon 92 Messages postés vendredi 20 janvier 2017Date d'inscription 12 décembre 2017 Dernière intervention
- 15 mai 2017 à 23:19
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


Afficher la suite 
92Messages postés vendredi 20 janvier 2017Date d'inscription 12 décembre 2017 Dernière intervention

4 réponses

Répondre au sujet
jordane45 19214 Messages postés mercredi 22 octobre 2003Date d'inscriptionModérateurStatut 13 décembre 2017 Dernière intervention - 15 mai 2017 à 10:49
0
Utile
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/excel/contribuez/supprimer-macros-macro/

.

Commenter la réponse de jordane45
Benoit_Lyon 92 Messages postés vendredi 20 janvier 2017Date d'inscription 12 décembre 2017 Dernière intervention - 15 mai 2017 à 15:05
0
Utile
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
Commenter la réponse de Benoit_Lyon
f894009 12541 Messages postés dimanche 25 novembre 2007Date d'inscription 11 décembre 2017 Dernière intervention - Modifié par f894009 le 15/05/2017 à 15:32
0
Utile
1
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
Benoit_Lyon 92 Messages postés vendredi 20 janvier 2017Date d'inscription 12 décembre 2017 Dernière intervention - 15 mai 2017 à 23:19
Ben ma réponse c'est Wahou. Je viens de voir votre message, je viens de mettre en place...et donc Wahou.
Propre, efficace, et en plus c'est plus rapide que la solution d'avant.

Merci énormément.
Je sais que ce ne sont que des mots, mais vous pouvez pas savoir à quel point vous m'apportez une aide précieuse. Merci
Commenter la réponse de f894009