Supprimer Macros

Résolu/Fermé

Benoit_Lyon Messages postés 98 Date d'inscription vendredi 20 janvier 2017 Statut Membre Dernière intervention 13 décembre 2017 - 15 mai 2017 à 10:27
Benoit_Lyon Messages postés 98 Date d'inscription vendredi 20 janvier 2017 Statut Membre Dernière intervention 13 décembre 2017 - 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

A voir également:

3 réponses

Réponse 1 / 3

jordane45 Messages postés 38138 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 17 avril 2024 4 649
15 mai 2017 à 10:49

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/

.

Réponse 2 / 3

Benoit_Lyon Messages postés 98 Date d'inscription vendredi 20 janvier 2017 Statut Membre Dernière intervention 13 décembre 2017 1
15 mai 2017 à 15:05

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

Réponse 3 / 3

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
Modifié le 15 mai 2017 à 15:32

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 Messages postés 98 Date d'inscription vendredi 20 janvier 2017 Statut Membre Dernière intervention 13 décembre 2017 1
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

Newsletters