Macro suppression feuilles

[Hx2000]

Bonjour à tous,

J'ai besoin d'aide concernant un code VBA. J'aimerais l'utiliser pour supprimer les nouvelles feuilles a la fermeture de Excel et non avant. Je suis débutant donc je ne sais pas trop comment passer cela en langage VBA du genre "Lorsqu'il y a une nouvelle feuille, la supprimer avant la fermeture (ou même l'enregistrement c'est mieux)". Voici mon code actuel qui empêche la création d'une nouvelle feuille.

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
End Sub

Merci d'avance pour votre aide

 

[chris]

Bonjour

Il faut à l'ouverture du classeur, créer un tableau des feuilles existantes et lors de la sauvegarde (BeforeSave) supprimer les feuilles qui n'y figurent pas.

Module standard

Public mesfeuilles()

Module ThisWorkbook

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    For j = 1 To ThisWorkbook.Worksheets.Count
        Trouve = False
        For i = 1 To UBound(mesfeuilles)
            If ThisWorkbook.Worksheets(j).CodeName = mesfeuilles(i) Then Trouve = True: Exit For
        Next i
        If Trouve = False Then
            Application.DisplayAlerts = False
            ThisWorkbook.Worksheets(j).Delete
            Application.DisplayAlerts = True
        End If
    Next j
End Sub

Private Sub Workbook_Open()
    ReDim mesfeuilles(ThisWorkbook.Worksheets.Count)
    For i = 1 To ThisWorkbook.Worksheets.Count
        mesfeuilles(i) = ThisWorkbook.Worksheets(i).CodeName
    Next i
End Sub

 

[Jean-Eric]

Bonjour,
Des éléments de réponse à adapter.
Cdlt.

Option Explicit
'-1-
Private Sub Workbook_NewSheet(ByVal sh As Object)
    sh.Name = "X " & sh.Name
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim sh As Worksheet
    Application.DisplayAlerts = False
    For Each sh In ThisWorkbook.Worksheets
        If Left(sh.Name, 1) = "X" Then sh.Delete
    Next sh
End Sub

'-2-
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim sh As Worksheet
    Application.DisplayAlerts = False
    For Each sh In ThisWorkbook.Worksheets
        Select Case sh.Name
            Case "Feuil1", "Feuil3", "Feuil6"
                '
            Case Else
                sh.Delete
        End Select
    Next sh
End Sub

 

[Hx2000]

Bonjour à vous deux, alors déjà, merci de votre aide et du temps passé à me répondre.

Je vais commencer par essayer le code de Chris. Cependant je ne comprends pas que représente "mesfeuilles"? Il faut que je rentre dans cette case toutes mes feuilles que je veux garder, ou seulement la feuille dans laquelle il y a mon tableau de feuilles à protéger?

J'espère que je suis clair

Merci encore

 

[chris]

Re

C'est juste un tableau en mémoire dimensionné dans un module standard puis alimenté dans le Workbook_open.

Tu n'a rien à écrire ailleurs.

 

[Hx2000]

D'accord merci, et encore une question de débutant

Public mesfeuilles()

Je le mets où ça?

L'autre partie je l'ai mise dans This Workbook et je pense que c'est ça, mais cette partie je sais pas trop? Dans un nouveau module?

 

[chris]

Re

Oui un nouveau module.

 

[job75]

Bonjour Hx2000, chris, Jean-Eric,

Esayez ce code dans ThisWorkbook :

Option Explicit
Dim d As Object 'mémorise la variable

Private Sub Workbook_Open()
Dim s As Object
Set d = CreateObject("Scripting.Dictionary")
For Each s In Sheets
d(s.CodeName) = ""
Next
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim s As Object
If d Is Nothing Then Exit Sub
Application.DisplayAlerts = False
For Each s In Sheets
If Not d.exists(s.CodeName) Then s.Delete
Next
End Sub

A+

 

[Hx2000]

Bonjour à tous,

désolé de ne pas avoir répondu hier, j'avais d'autres choses à faire...
J'ai donc essayé ce matin de résoudre ce problème avec vos 3 méthodes et aucunes n'a marché.
Enfin... Chris, ce que tu m'as donné comme code fonctionne, mais fait entrer Excel en Débogage à chaque fois.
Job75, malheureusement cela ne fonctionne pas du tout pour moi..
Et Jean-Eric, je sais pas vraiment si il marche ou pas, mais la macro me fait planter excel "Excel ne répond plus..."
Si vous avez d'autres solutions, je suis preneur...
Merci d'avance

 

[job75]

Bonjour Hx2000, le fil,

Job75, malheureusement cela ne fonctionne pas du tout pour moi..

Après avoir collé tout mon code dans ThisWorkbook, il faut bien sûr fermer et rouvrir le fichier.

Sinon déposez ici votre fichier s'il ne "fonctionne pas du tout".

A+

 

[Hx2000]

Ah merci ça fonctionne, je ne sais pas pourquoi ça n'a pas marché la première fois... C'est peut-être dû au fait que j'ai déjà des macros et que du coup c'est pas forcément facile d'en intégrer une nouvelle dans le tas... avec un peu de persévérance je finirais par réussir à l'intégrer! Merci encore!

 

[Hx2000]

C'est bon j'ai réussi!
Merci beaucoup à tout le monde pour le temps passé à m'aider!